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
;
313 Time time
= last_event_timestamp
;
315 struct x_display_info
*dpyinfo
;
318 if (! FRAME_X_P (sf
))
321 selecting_window
= FRAME_X_WINDOW (sf
);
322 display
= FRAME_X_DISPLAY (sf
);
323 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
325 CHECK_SYMBOL (selection_name
);
326 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
329 count
= x_catch_errors (display
);
330 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
331 x_check_errors (display
, "Can't set selection: %s");
332 x_uncatch_errors (display
, count
);
335 /* Now update the local cache */
337 Lisp_Object selection_time
;
338 Lisp_Object selection_data
;
339 Lisp_Object prev_value
;
341 selection_time
= long_to_cons ((unsigned long) time
);
342 selection_data
= Fcons (selection_name
,
343 Fcons (selection_value
,
344 Fcons (selection_time
,
345 Fcons (selected_frame
, Qnil
))));
346 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
348 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
350 /* If we already owned the selection, remove the old selection data.
351 Perhaps we should destructively modify it instead.
352 Don't use Fdelq as that may QUIT. */
353 if (!NILP (prev_value
))
355 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
356 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
357 if (EQ (prev_value
, Fcar (XCDR (rest
))))
359 XSETCDR (rest
, Fcdr (XCDR (rest
)));
366 /* Given a selection-name and desired type, look up our local copy of
367 the selection value and convert it to the type.
368 The value is nil or a string.
369 This function is used both for remote requests (LOCAL_REQUEST is zero)
370 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
372 This calls random Lisp code, and may signal or gc. */
375 x_get_local_selection (selection_symbol
, target_type
, local_request
)
376 Lisp_Object selection_symbol
, target_type
;
379 Lisp_Object local_value
;
380 Lisp_Object handler_fn
, value
, type
, check
;
383 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
385 if (NILP (local_value
)) return Qnil
;
387 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
388 if (EQ (target_type
, QTIMESTAMP
))
391 value
= XCAR (XCDR (XCDR (local_value
)));
394 else if (EQ (target_type
, QDELETE
))
397 Fx_disown_selection_internal
399 XCAR (XCDR (XCDR (local_value
))));
404 #if 0 /* #### MULTIPLE doesn't work yet */
405 else if (CONSP (target_type
)
406 && XCAR (target_type
) == QMULTIPLE
)
411 pairs
= XCDR (target_type
);
412 size
= XVECTOR (pairs
)->size
;
413 /* If the target is MULTIPLE, then target_type looks like
414 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
415 We modify the second element of each pair in the vector and
416 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
418 for (i
= 0; i
< size
; i
++)
421 pair
= XVECTOR (pairs
)->contents
[i
];
422 XVECTOR (pair
)->contents
[1]
423 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
424 XVECTOR (pair
)->contents
[1],
432 /* Don't allow a quit within the converter.
433 When the user types C-g, he would be surprised
434 if by luck it came during a converter. */
435 count
= SPECPDL_INDEX ();
436 specbind (Qinhibit_quit
, Qt
);
438 CHECK_SYMBOL (target_type
);
439 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
440 /* gcpro is not needed here since nothing but HANDLER_FN
441 is live, and that ought to be a symbol. */
443 if (!NILP (handler_fn
))
444 value
= call3 (handler_fn
,
445 selection_symbol
, (local_request
? Qnil
: target_type
),
446 XCAR (XCDR (local_value
)));
449 unbind_to (count
, Qnil
);
452 /* Make sure this value is of a type that we could transmit
453 to another X client. */
457 && SYMBOLP (XCAR (value
)))
459 check
= XCDR (value
);
467 /* Check for a value that cons_to_long could handle. */
468 else if (CONSP (check
)
469 && INTEGERP (XCAR (check
))
470 && (INTEGERP (XCDR (check
))
472 (CONSP (XCDR (check
))
473 && INTEGERP (XCAR (XCDR (check
)))
474 && NILP (XCDR (XCDR (check
))))))
479 Fcons (build_string ("invalid data returned by selection-conversion function"),
480 Fcons (handler_fn
, Fcons (value
, Qnil
))));
483 /* Subroutines of x_reply_selection_request. */
485 /* Send a SelectionNotify event to the requestor with property=None,
486 meaning we were unable to do what they wanted. */
489 x_decline_selection_request (event
)
490 struct input_event
*event
;
492 XSelectionEvent reply
;
495 reply
.type
= SelectionNotify
;
496 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
497 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
498 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
499 reply
.time
= SELECTION_EVENT_TIME (event
);
500 reply
.target
= SELECTION_EVENT_TARGET (event
);
501 reply
.property
= None
;
503 /* The reason for the error may be that the receiver has
504 died in the meantime. Handle that case. */
506 count
= x_catch_errors (reply
.display
);
507 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
508 XFlush (reply
.display
);
509 x_uncatch_errors (reply
.display
, count
);
513 /* This is the selection request currently being processed.
514 It is set to zero when the request is fully processed. */
515 static struct input_event
*x_selection_current_request
;
517 /* Display info in x_selection_request. */
519 static struct x_display_info
*selection_request_dpyinfo
;
521 /* Used as an unwind-protect clause so that, if a selection-converter signals
522 an error, we tell the requester that we were unable to do what they wanted
523 before we throw to top-level or go into the debugger or whatever. */
526 x_selection_request_lisp_error (ignore
)
529 if (x_selection_current_request
!= 0
530 && selection_request_dpyinfo
->display
)
531 x_decline_selection_request (x_selection_current_request
);
536 /* This stuff is so that INCR selections are reentrant (that is, so we can
537 be servicing multiple INCR selection requests simultaneously.) I haven't
538 actually tested that yet. */
540 /* Keep a list of the property changes that are awaited. */
550 struct prop_location
*next
;
553 static struct prop_location
*expect_property_change ();
554 static void wait_for_property_change ();
555 static void unexpect_property_change ();
556 static int waiting_for_other_props_on_window ();
558 static int prop_location_identifier
;
560 static Lisp_Object property_change_reply
;
562 static struct prop_location
*property_change_reply_object
;
564 static struct prop_location
*property_change_wait_list
;
567 queue_selection_requests_unwind (frame
)
570 FRAME_PTR f
= XFRAME (frame
);
573 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
577 /* Return some frame whose display info is DPYINFO.
578 Return nil if there is none. */
581 some_frame_on_display (dpyinfo
)
582 struct x_display_info
*dpyinfo
;
584 Lisp_Object list
, frame
;
586 FOR_EACH_FRAME (list
, frame
)
588 if (FRAME_X_P (XFRAME (frame
))
589 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
596 /* Send the reply to a selection request event EVENT.
597 TYPE is the type of selection data requested.
598 DATA and SIZE describe the data to send, already converted.
599 FORMAT is the unit-size (in bits) of the data to be transmitted. */
602 x_reply_selection_request (event
, format
, data
, size
, type
)
603 struct input_event
*event
;
608 XSelectionEvent reply
;
609 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
610 Window window
= SELECTION_EVENT_REQUESTOR (event
);
612 int format_bytes
= format
/8;
613 int max_bytes
= SELECTION_QUANTUM (display
);
614 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
617 if (max_bytes
> MAX_SELECTION_QUANTUM
)
618 max_bytes
= MAX_SELECTION_QUANTUM
;
620 reply
.type
= SelectionNotify
;
621 reply
.display
= display
;
622 reply
.requestor
= window
;
623 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
624 reply
.time
= SELECTION_EVENT_TIME (event
);
625 reply
.target
= SELECTION_EVENT_TARGET (event
);
626 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
627 if (reply
.property
== None
)
628 reply
.property
= reply
.target
;
630 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
632 count
= x_catch_errors (display
);
634 /* Store the data on the requested property.
635 If the selection is large, only store the first N bytes of it.
637 bytes_remaining
= size
* format_bytes
;
638 if (bytes_remaining
<= max_bytes
)
640 /* Send all the data at once, with minimal handshaking. */
641 TRACE1 ("Sending all %d bytes", bytes_remaining
);
642 XChangeProperty (display
, window
, reply
.property
, type
, format
,
643 PropModeReplace
, data
, size
);
644 /* At this point, the selection was successfully stored; ack it. */
645 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
649 /* Send an INCR selection. */
650 struct prop_location
*wait_object
;
654 frame
= some_frame_on_display (dpyinfo
);
656 /* If the display no longer has frames, we can't expect
657 to get many more selection requests from it, so don't
658 bother trying to queue them. */
661 x_start_queuing_selection_requests (display
);
663 record_unwind_protect (queue_selection_requests_unwind
,
667 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
668 error ("Attempt to transfer an INCR to ourself!");
670 TRACE2 ("Start sending %d bytes incrementally (%s)",
671 bytes_remaining
, XGetAtomName (display
, reply
.property
));
672 wait_object
= expect_property_change (display
, window
, reply
.property
,
675 TRACE1 ("Set %s to number of bytes to send",
676 XGetAtomName (display
, reply
.property
));
677 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
679 (unsigned char *) &bytes_remaining
, 1);
680 XSelectInput (display
, window
, PropertyChangeMask
);
682 /* Tell 'em the INCR data is there... */
683 TRACE0 ("Send SelectionNotify event");
684 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
687 had_errors
= x_had_errors_p (display
);
690 /* First, wait for the requester to ack by deleting the property.
691 This can run random lisp code (process handlers) or signal. */
694 TRACE1 ("Waiting for ACK (deletion of %s)",
695 XGetAtomName (display
, reply
.property
));
696 wait_for_property_change (wait_object
);
700 while (bytes_remaining
)
702 int i
= ((bytes_remaining
< max_bytes
)
709 = expect_property_change (display
, window
, reply
.property
,
712 TRACE1 ("Sending increment of %d bytes", i
);
713 TRACE1 ("Set %s to increment data",
714 XGetAtomName (display
, reply
.property
));
716 /* Append the next chunk of data to the property. */
717 XChangeProperty (display
, window
, reply
.property
, type
, format
,
718 PropModeAppend
, data
, i
/ format_bytes
);
719 bytes_remaining
-= i
;
722 had_errors
= x_had_errors_p (display
);
728 /* Now wait for the requester to ack this chunk by deleting the
729 property. This can run random lisp code or signal. */
730 TRACE1 ("Waiting for increment ACK (deletion of %s)",
731 XGetAtomName (display
, reply
.property
));
732 wait_for_property_change (wait_object
);
735 /* Now write a zero-length chunk to the property to tell the
736 requester that we're done. */
738 if (! waiting_for_other_props_on_window (display
, window
))
739 XSelectInput (display
, window
, 0L);
741 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
742 XGetAtomName (display
, reply
.property
));
743 XChangeProperty (display
, window
, reply
.property
, type
, format
,
744 PropModeReplace
, data
, 0);
745 TRACE0 ("Done sending incrementally");
748 /* rms, 2003-01-03: I think I have fixed this bug. */
749 /* The window we're communicating with may have been deleted
750 in the meantime (that's a real situation from a bug report).
751 In this case, there may be events in the event queue still
752 refering to the deleted window, and we'll get a BadWindow error
753 in XTread_socket when processing the events. I don't have
754 an idea how to fix that. gerd, 2001-01-98. */
755 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
756 delivered before uncatch errors. */
757 XSync (display
, False
);
760 /* GTK queues events in addition to the queue in Xlib. So we
761 UNBLOCK to enter the event loop and get possible errors delivered,
762 and then BLOCK again because x_uncatch_errors requires it. */
764 x_uncatch_errors (display
, count
);
768 /* Handle a SelectionRequest event EVENT.
769 This is called from keyboard.c when such an event is found in the queue. */
772 x_handle_selection_request (event
)
773 struct input_event
*event
;
775 struct gcpro gcpro1
, gcpro2
, gcpro3
;
776 Lisp_Object local_selection_data
;
777 Lisp_Object selection_symbol
;
778 Lisp_Object target_symbol
;
779 Lisp_Object converted_selection
;
780 Time local_selection_time
;
781 Lisp_Object successful_p
;
783 struct x_display_info
*dpyinfo
784 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
786 local_selection_data
= Qnil
;
787 target_symbol
= Qnil
;
788 converted_selection
= Qnil
;
791 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
793 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
794 SELECTION_EVENT_SELECTION (event
));
796 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
798 if (NILP (local_selection_data
))
800 /* Someone asked for the selection, but we don't have it any more.
802 x_decline_selection_request (event
);
806 local_selection_time
= (Time
)
807 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
809 if (SELECTION_EVENT_TIME (event
) != CurrentTime
810 && local_selection_time
> SELECTION_EVENT_TIME (event
))
812 /* Someone asked for the selection, and we have one, but not the one
815 x_decline_selection_request (event
);
819 x_selection_current_request
= event
;
820 count
= SPECPDL_INDEX ();
821 selection_request_dpyinfo
= dpyinfo
;
822 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
824 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
825 SELECTION_EVENT_TARGET (event
));
827 #if 0 /* #### MULTIPLE doesn't work yet */
828 if (EQ (target_symbol
, QMULTIPLE
))
829 target_symbol
= fetch_multiple_target (event
);
832 /* Convert lisp objects back into binary data */
835 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
837 if (! NILP (converted_selection
))
845 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
847 &data
, &type
, &size
, &format
, &nofree
);
849 x_reply_selection_request (event
, format
, data
, size
, type
);
852 /* Indicate we have successfully processed this event. */
853 x_selection_current_request
= 0;
855 /* Use xfree, not XFree, because lisp_data_to_selection_data
856 calls xmalloc itself. */
860 unbind_to (count
, Qnil
);
864 /* Let random lisp code notice that the selection has been asked for. */
867 rest
= Vx_sent_selection_hooks
;
868 if (!EQ (rest
, Qunbound
))
869 for (; CONSP (rest
); rest
= Fcdr (rest
))
870 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
876 /* Handle a SelectionClear event EVENT, which indicates that some
877 client cleared out our previously asserted selection.
878 This is called from keyboard.c when such an event is found in the queue. */
881 x_handle_selection_clear (event
)
882 struct input_event
*event
;
884 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
885 Atom selection
= SELECTION_EVENT_SELECTION (event
);
886 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
888 Lisp_Object selection_symbol
, local_selection_data
;
889 Time local_selection_time
;
890 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
891 struct x_display_info
*t_dpyinfo
;
893 /* If the new selection owner is also Emacs,
894 don't clear the new selection. */
896 /* Check each display on the same terminal,
897 to see if this Emacs job now owns the selection
898 through that display. */
899 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
900 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
903 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
904 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
912 selection_symbol
= x_atom_to_symbol (display
, selection
);
914 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
916 /* Well, we already believe that we don't own it, so that's just fine. */
917 if (NILP (local_selection_data
)) return;
919 local_selection_time
= (Time
)
920 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
922 /* This SelectionClear is for a selection that we no longer own, so we can
923 disregard it. (That is, we have reasserted the selection since this
924 request was generated.) */
926 if (changed_owner_time
!= CurrentTime
927 && local_selection_time
> changed_owner_time
)
930 /* Otherwise, we're really honest and truly being told to drop it.
931 Don't use Fdelq as that may QUIT;. */
933 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
934 Vselection_alist
= Fcdr (Vselection_alist
);
938 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
939 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
941 XSETCDR (rest
, Fcdr (XCDR (rest
)));
946 /* Let random lisp code notice that the selection has been stolen. */
950 rest
= Vx_lost_selection_hooks
;
951 if (!EQ (rest
, Qunbound
))
953 for (; CONSP (rest
); rest
= Fcdr (rest
))
954 call1 (Fcar (rest
), selection_symbol
);
955 prepare_menu_bars ();
956 redisplay_preserve_echo_area (20);
961 /* Clear all selections that were made from frame F.
962 We do this when about to delete a frame. */
965 x_clear_frame_selections (f
)
971 XSETFRAME (frame
, f
);
973 /* Otherwise, we're really honest and truly being told to drop it.
974 Don't use Fdelq as that may QUIT;. */
976 /* Delete elements from the beginning of Vselection_alist. */
977 while (!NILP (Vselection_alist
)
978 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
980 /* Let random Lisp code notice that the selection has been stolen. */
981 Lisp_Object hooks
, selection_symbol
;
983 hooks
= Vx_lost_selection_hooks
;
984 selection_symbol
= Fcar (Fcar (Vselection_alist
));
986 if (!EQ (hooks
, Qunbound
))
988 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
989 call1 (Fcar (hooks
), selection_symbol
);
990 #if 0 /* This can crash when deleting a frame
991 from x_connection_closed. Anyway, it seems unnecessary;
992 something else should cause a redisplay. */
993 redisplay_preserve_echo_area (21);
997 Vselection_alist
= Fcdr (Vselection_alist
);
1000 /* Delete elements after the beginning of Vselection_alist. */
1001 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1002 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1004 /* Let random Lisp code notice that the selection has been stolen. */
1005 Lisp_Object hooks
, selection_symbol
;
1007 hooks
= Vx_lost_selection_hooks
;
1008 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1010 if (!EQ (hooks
, Qunbound
))
1012 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1013 call1 (Fcar (hooks
), selection_symbol
);
1014 #if 0 /* See above */
1015 redisplay_preserve_echo_area (22);
1018 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1023 /* Nonzero if any properties for DISPLAY and WINDOW
1024 are on the list of what we are waiting for. */
1027 waiting_for_other_props_on_window (display
, window
)
1031 struct prop_location
*rest
= property_change_wait_list
;
1033 if (rest
->display
== display
&& rest
->window
== window
)
1040 /* Add an entry to the list of property changes we are waiting for.
1041 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1042 The return value is a number that uniquely identifies
1043 this awaited property change. */
1045 static struct prop_location
*
1046 expect_property_change (display
, window
, property
, state
)
1052 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1053 pl
->identifier
= ++prop_location_identifier
;
1054 pl
->display
= display
;
1055 pl
->window
= window
;
1056 pl
->property
= property
;
1057 pl
->desired_state
= state
;
1058 pl
->next
= property_change_wait_list
;
1060 property_change_wait_list
= pl
;
1064 /* Delete an entry from the list of property changes we are waiting for.
1065 IDENTIFIER is the number that uniquely identifies the entry. */
1068 unexpect_property_change (location
)
1069 struct prop_location
*location
;
1071 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1074 if (rest
== location
)
1077 prev
->next
= rest
->next
;
1079 property_change_wait_list
= rest
->next
;
1088 /* Remove the property change expectation element for IDENTIFIER. */
1091 wait_for_property_change_unwind (identifierval
)
1092 Lisp_Object identifierval
;
1094 unexpect_property_change ((struct prop_location
*)
1095 (XFASTINT (XCAR (identifierval
)) << 16
1096 | XFASTINT (XCDR (identifierval
))));
1100 /* Actually wait for a property change.
1101 IDENTIFIER should be the value that expect_property_change returned. */
1104 wait_for_property_change (location
)
1105 struct prop_location
*location
;
1108 int count
= SPECPDL_INDEX ();
1111 tem
= Fcons (Qnil
, Qnil
);
1112 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1113 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1115 /* Make sure to do unexpect_property_change if we quit or err. */
1116 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1118 XSETCAR (property_change_reply
, Qnil
);
1120 property_change_reply_object
= location
;
1121 /* If the event we are waiting for arrives beyond here, it will set
1122 property_change_reply, because property_change_reply_object says so. */
1123 if (! location
->arrived
)
1125 secs
= x_selection_timeout
/ 1000;
1126 usecs
= (x_selection_timeout
% 1000) * 1000;
1127 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1128 wait_reading_process_output (secs
, usecs
, 0, 0,
1129 property_change_reply
, NULL
, 0);
1131 if (NILP (XCAR (property_change_reply
)))
1133 TRACE0 (" Timed out");
1134 error ("Timed out waiting for property-notify event");
1138 unbind_to (count
, Qnil
);
1141 /* Called from XTread_socket in response to a PropertyNotify event. */
1144 x_handle_property_notify (event
)
1145 XPropertyEvent
*event
;
1147 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1151 if (rest
->property
== event
->atom
1152 && rest
->window
== event
->window
1153 && rest
->display
== event
->display
1154 && rest
->desired_state
== event
->state
)
1156 TRACE2 ("Expected %s of property %s",
1157 (event
->state
== PropertyDelete
? "deletion" : "change"),
1158 XGetAtomName (event
->display
, event
->atom
));
1162 /* If this is the one wait_for_property_change is waiting for,
1163 tell it to wake up. */
1164 if (rest
== property_change_reply_object
)
1165 XSETCAR (property_change_reply
, Qt
);
1168 prev
->next
= rest
->next
;
1170 property_change_wait_list
= rest
->next
;
1182 #if 0 /* #### MULTIPLE doesn't work yet */
1185 fetch_multiple_target (event
)
1186 XSelectionRequestEvent
*event
;
1188 Display
*display
= event
->display
;
1189 Window window
= event
->requestor
;
1190 Atom target
= event
->target
;
1191 Atom selection_atom
= event
->selection
;
1196 x_get_window_property_as_lisp_data (display
, window
, target
,
1197 QMULTIPLE
, selection_atom
));
1201 copy_multiple_data (obj
)
1208 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1211 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1212 for (i
= 0; i
< size
; i
++)
1214 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1215 CHECK_VECTOR (vec2
);
1216 if (XVECTOR (vec2
)->size
!= 2)
1217 /* ??? Confusing error message */
1218 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1219 Fcons (vec2
, Qnil
)));
1220 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1221 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1222 = XVECTOR (vec2
)->contents
[0];
1223 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1224 = XVECTOR (vec2
)->contents
[1];
1232 /* Variables for communication with x_handle_selection_notify. */
1233 static Atom reading_which_selection
;
1234 static Lisp_Object reading_selection_reply
;
1235 static Window reading_selection_window
;
1237 /* Do protocol to read selection-data from the server.
1238 Converts this to Lisp data and returns it. */
1241 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1242 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1244 struct frame
*sf
= SELECTED_FRAME ();
1245 Window requestor_window
;
1247 struct x_display_info
*dpyinfo
;
1248 Time requestor_time
= last_event_timestamp
;
1249 Atom target_property
;
1250 Atom selection_atom
;
1256 if (! FRAME_X_P (sf
))
1259 requestor_window
= FRAME_X_WINDOW (sf
);
1260 display
= FRAME_X_DISPLAY (sf
);
1261 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1262 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1263 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1265 if (CONSP (target_type
))
1266 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1268 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1270 if (! NILP (time_stamp
))
1272 if (CONSP (time_stamp
))
1273 requestor_time
= (Time
) cons_to_long (time_stamp
);
1274 else if (INTEGERP (time_stamp
))
1275 requestor_time
= (Time
) XUINT (time_stamp
);
1276 else if (FLOATP (time_stamp
))
1277 requestor_time
= (Time
) XFLOAT (time_stamp
);
1279 error ("TIME_STAMP must be cons or number");
1284 count
= x_catch_errors (display
);
1286 TRACE2 ("Get selection %s, type %s",
1287 XGetAtomName (display
, type_atom
),
1288 XGetAtomName (display
, target_property
));
1290 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1291 requestor_window
, requestor_time
);
1294 /* Prepare to block until the reply has been read. */
1295 reading_selection_window
= requestor_window
;
1296 reading_which_selection
= selection_atom
;
1297 XSETCAR (reading_selection_reply
, Qnil
);
1299 frame
= some_frame_on_display (dpyinfo
);
1301 /* If the display no longer has frames, we can't expect
1302 to get many more selection requests from it, so don't
1303 bother trying to queue them. */
1306 x_start_queuing_selection_requests (display
);
1308 record_unwind_protect (queue_selection_requests_unwind
,
1313 /* This allows quits. Also, don't wait forever. */
1314 secs
= x_selection_timeout
/ 1000;
1315 usecs
= (x_selection_timeout
% 1000) * 1000;
1316 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1317 wait_reading_process_output (secs
, usecs
, 0, 0,
1318 reading_selection_reply
, NULL
, 0);
1319 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1322 x_check_errors (display
, "Cannot get selection: %s");
1323 x_uncatch_errors (display
, count
);
1326 if (NILP (XCAR (reading_selection_reply
)))
1327 error ("Timed out waiting for reply from selection owner");
1328 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1329 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1331 /* Otherwise, the selection is waiting for us on the requested property. */
1333 x_get_window_property_as_lisp_data (display
, requestor_window
,
1334 target_property
, target_type
,
1338 /* Subroutines of x_get_window_property_as_lisp_data */
1340 /* Use xfree, not XFree, to free the data obtained with this function. */
1343 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1344 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1349 unsigned char **data_ret
;
1351 Atom
*actual_type_ret
;
1352 int *actual_format_ret
;
1353 unsigned long *actual_size_ret
;
1357 unsigned long bytes_remaining
;
1359 unsigned char *tmp_data
= 0;
1361 int buffer_size
= SELECTION_QUANTUM (display
);
1363 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1364 buffer_size
= MAX_SELECTION_QUANTUM
;
1368 /* First probe the thing to find out how big it is. */
1369 result
= XGetWindowProperty (display
, window
, property
,
1370 0L, 0L, False
, AnyPropertyType
,
1371 actual_type_ret
, actual_format_ret
,
1373 &bytes_remaining
, &tmp_data
);
1374 if (result
!= Success
)
1382 /* This was allocated by Xlib, so use XFree. */
1383 XFree ((char *) tmp_data
);
1385 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1391 total_size
= bytes_remaining
+ 1;
1392 *data_ret
= (unsigned char *) xmalloc (total_size
);
1394 /* Now read, until we've gotten it all. */
1395 while (bytes_remaining
)
1397 #ifdef TRACE_SELECTION
1398 int last
= bytes_remaining
;
1401 = XGetWindowProperty (display
, window
, property
,
1402 (long)offset
/4, (long)buffer_size
/4,
1405 actual_type_ret
, actual_format_ret
,
1406 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1408 TRACE2 ("Read %ld bytes from property %s",
1409 last
- bytes_remaining
,
1410 XGetAtomName (display
, property
));
1412 /* If this doesn't return Success at this point, it means that
1413 some clod deleted the selection while we were in the midst of
1414 reading it. Deal with that, I guess.... */
1415 if (result
!= Success
)
1417 *actual_size_ret
*= *actual_format_ret
/ 8;
1418 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1419 offset
+= *actual_size_ret
;
1421 /* This was allocated by Xlib, so use XFree. */
1422 XFree ((char *) tmp_data
);
1427 *bytes_ret
= offset
;
1430 /* Use xfree, not XFree, to free the data obtained with this function. */
1433 receive_incremental_selection (display
, window
, property
, target_type
,
1434 min_size_bytes
, data_ret
, size_bytes_ret
,
1435 type_ret
, format_ret
, size_ret
)
1439 Lisp_Object target_type
; /* for error messages only */
1440 unsigned int min_size_bytes
;
1441 unsigned char **data_ret
;
1442 int *size_bytes_ret
;
1444 unsigned long *size_ret
;
1448 struct prop_location
*wait_object
;
1449 *size_bytes_ret
= min_size_bytes
;
1450 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1452 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1454 /* At this point, we have read an INCR property.
1455 Delete the property to ack it.
1456 (But first, prepare to receive the next event in this handshake.)
1458 Now, we must loop, waiting for the sending window to put a value on
1459 that property, then reading the property, then deleting it to ack.
1460 We are done when the sender places a property of length 0.
1463 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1464 TRACE1 (" Delete property %s",
1465 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1466 XDeleteProperty (display
, window
, property
);
1467 TRACE1 (" Expect new value of property %s",
1468 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1469 wait_object
= expect_property_change (display
, window
, property
,
1476 unsigned char *tmp_data
;
1479 TRACE0 (" Wait for property change");
1480 wait_for_property_change (wait_object
);
1482 /* expect it again immediately, because x_get_window_property may
1483 .. no it won't, I don't get it.
1484 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1485 TRACE0 (" Get property value");
1486 x_get_window_property (display
, window
, property
,
1487 &tmp_data
, &tmp_size_bytes
,
1488 type_ret
, format_ret
, size_ret
, 1);
1490 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1492 if (tmp_size_bytes
== 0) /* we're done */
1494 TRACE0 ("Done reading incrementally");
1496 if (! waiting_for_other_props_on_window (display
, window
))
1497 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1498 unexpect_property_change (wait_object
);
1499 /* Use xfree, not XFree, because x_get_window_property
1500 calls xmalloc itself. */
1501 if (tmp_data
) xfree (tmp_data
);
1506 TRACE1 (" ACK by deleting property %s",
1507 XGetAtomName (display
, property
));
1508 XDeleteProperty (display
, window
, property
);
1509 wait_object
= expect_property_change (display
, window
, property
,
1514 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1516 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1517 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1520 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1521 offset
+= tmp_size_bytes
;
1523 /* Use xfree, not XFree, because x_get_window_property
1524 calls xmalloc itself. */
1530 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1531 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1532 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1535 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1540 Lisp_Object target_type
; /* for error messages only */
1541 Atom selection_atom
; /* for error messages only */
1545 unsigned long actual_size
;
1546 unsigned char *data
= 0;
1549 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1551 TRACE0 ("Reading selection data");
1553 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1554 &actual_type
, &actual_format
, &actual_size
, 1);
1557 int there_is_a_selection_owner
;
1559 there_is_a_selection_owner
1560 = XGetSelectionOwner (display
, selection_atom
);
1563 there_is_a_selection_owner
1564 ? Fcons (build_string ("selection owner couldn't convert"),
1566 ? Fcons (target_type
,
1567 Fcons (x_atom_to_symbol (display
,
1570 : Fcons (target_type
, Qnil
))
1571 : Fcons (build_string ("no selection"),
1572 Fcons (x_atom_to_symbol (display
,
1577 if (actual_type
== dpyinfo
->Xatom_INCR
)
1579 /* That wasn't really the data, just the beginning. */
1581 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1583 /* Use xfree, not XFree, because x_get_window_property
1584 calls xmalloc itself. */
1585 xfree ((char *) data
);
1587 receive_incremental_selection (display
, window
, property
, target_type
,
1588 min_size_bytes
, &data
, &bytes
,
1589 &actual_type
, &actual_format
,
1594 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1595 XDeleteProperty (display
, window
, property
);
1599 /* It's been read. Now convert it to a lisp object in some semi-rational
1601 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1602 actual_type
, actual_format
);
1604 /* Use xfree, not XFree, because x_get_window_property
1605 calls xmalloc itself. */
1606 xfree ((char *) data
);
1610 /* These functions convert from the selection data read from the server into
1611 something that we can use from Lisp, and vice versa.
1613 Type: Format: Size: Lisp Type:
1614 ----- ------- ----- -----------
1617 ATOM 32 > 1 Vector of Symbols
1619 * 16 > 1 Vector of Integers
1620 * 32 1 if <=16 bits: Integer
1621 if > 16 bits: Cons of top16, bot16
1622 * 32 > 1 Vector of the above
1624 When converting a Lisp number to C, it is assumed to be of format 16 if
1625 it is an integer, and of format 32 if it is a cons of two integers.
1627 When converting a vector of numbers from Lisp to C, it is assumed to be
1628 of format 16 if every element in the vector is an integer, and is assumed
1629 to be of format 32 if any element is a cons of two integers.
1631 When converting an object to C, it may be of the form (SYMBOL . <data>)
1632 where SYMBOL is what we should claim that the type is. Format and
1633 representation are as above. */
1638 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1640 unsigned char *data
;
1644 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1646 if (type
== dpyinfo
->Xatom_NULL
)
1649 /* Convert any 8-bit data to a string, for compactness. */
1650 else if (format
== 8)
1652 Lisp_Object str
, lispy_type
;
1654 str
= make_unibyte_string ((char *) data
, size
);
1655 /* Indicate that this string is from foreign selection by a text
1656 property `foreign-selection' so that the caller of
1657 x-get-selection-internal (usually x-get-selection) can know
1658 that the string must be decode. */
1659 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1660 lispy_type
= QCOMPOUND_TEXT
;
1661 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1662 lispy_type
= QUTF8_STRING
;
1664 lispy_type
= QSTRING
;
1665 Fput_text_property (make_number (0), make_number (size
),
1666 Qforeign_selection
, lispy_type
, str
);
1669 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1670 a vector of symbols.
1672 else if (type
== XA_ATOM
)
1675 if (size
== sizeof (Atom
))
1676 return x_atom_to_symbol (display
, *((Atom
*) data
));
1679 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1681 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1682 Faset (v
, make_number (i
),
1683 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1688 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1689 If the number is > 16 bits, convert it to a cons of integers,
1690 16 bits in each half.
1692 else if (format
== 32 && size
== sizeof (int))
1693 return long_to_cons (((unsigned int *) data
) [0]);
1694 else if (format
== 16 && size
== sizeof (short))
1695 return make_number ((int) (((unsigned short *) data
) [0]));
1697 /* Convert any other kind of data to a vector of numbers, represented
1698 as above (as an integer, or a cons of two 16 bit integers.)
1700 else if (format
== 16)
1704 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1705 for (i
= 0; i
< size
/ 2; i
++)
1707 int j
= (int) ((unsigned short *) data
) [i
];
1708 Faset (v
, make_number (i
), make_number (j
));
1715 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1716 for (i
= 0; i
< size
/ 4; i
++)
1718 unsigned int j
= ((unsigned int *) data
) [i
];
1719 Faset (v
, make_number (i
), long_to_cons (j
));
1726 /* Use xfree, not XFree, to free the data obtained with this function. */
1729 lisp_data_to_selection_data (display
, obj
,
1730 data_ret
, type_ret
, size_ret
,
1731 format_ret
, nofree_ret
)
1734 unsigned char **data_ret
;
1736 unsigned int *size_ret
;
1740 Lisp_Object type
= Qnil
;
1741 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1745 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1749 if (CONSP (obj
) && NILP (XCDR (obj
)))
1753 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1754 { /* This is not the same as declining */
1760 else if (STRINGP (obj
))
1762 xassert (! STRING_MULTIBYTE (obj
));
1766 *size_ret
= SBYTES (obj
);
1767 *data_ret
= SDATA (obj
);
1770 else if (SYMBOLP (obj
))
1774 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1775 (*data_ret
) [sizeof (Atom
)] = 0;
1776 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1777 if (NILP (type
)) type
= QATOM
;
1779 else if (INTEGERP (obj
)
1780 && XINT (obj
) < 0xFFFF
1781 && XINT (obj
) > -0xFFFF)
1785 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1786 (*data_ret
) [sizeof (short)] = 0;
1787 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1788 if (NILP (type
)) type
= QINTEGER
;
1790 else if (INTEGERP (obj
)
1791 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1792 && (INTEGERP (XCDR (obj
))
1793 || (CONSP (XCDR (obj
))
1794 && INTEGERP (XCAR (XCDR (obj
)))))))
1798 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1799 (*data_ret
) [sizeof (long)] = 0;
1800 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1801 if (NILP (type
)) type
= QINTEGER
;
1803 else if (VECTORP (obj
))
1805 /* Lisp_Vectors may represent a set of ATOMs;
1806 a set of 16 or 32 bit INTEGERs;
1807 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1811 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1812 /* This vector is an ATOM set */
1814 if (NILP (type
)) type
= QATOM
;
1815 *size_ret
= XVECTOR (obj
)->size
;
1817 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1818 for (i
= 0; i
< *size_ret
; i
++)
1819 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1820 (*(Atom
**) data_ret
) [i
]
1821 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1823 Fsignal (Qerror
, /* Qselection_error */
1825 ("all elements of selection vector must have same type"),
1826 Fcons (obj
, Qnil
)));
1828 #if 0 /* #### MULTIPLE doesn't work yet */
1829 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1830 /* This vector is an ATOM_PAIR set */
1832 if (NILP (type
)) type
= QATOM_PAIR
;
1833 *size_ret
= XVECTOR (obj
)->size
;
1835 *data_ret
= (unsigned char *)
1836 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1837 for (i
= 0; i
< *size_ret
; i
++)
1838 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1840 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1841 if (XVECTOR (pair
)->size
!= 2)
1844 ("elements of the vector must be vectors of exactly two elements"),
1845 Fcons (pair
, Qnil
)));
1847 (*(Atom
**) data_ret
) [i
* 2]
1848 = symbol_to_x_atom (dpyinfo
, display
,
1849 XVECTOR (pair
)->contents
[0]);
1850 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1851 = symbol_to_x_atom (dpyinfo
, display
,
1852 XVECTOR (pair
)->contents
[1]);
1857 ("all elements of the vector must be of the same type"),
1858 Fcons (obj
, Qnil
)));
1863 /* This vector is an INTEGER set, or something like it */
1865 *size_ret
= XVECTOR (obj
)->size
;
1866 if (NILP (type
)) type
= QINTEGER
;
1868 for (i
= 0; i
< *size_ret
; i
++)
1869 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1871 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1872 Fsignal (Qerror
, /* Qselection_error */
1874 ("elements of selection vector must be integers or conses of integers"),
1875 Fcons (obj
, Qnil
)));
1877 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1878 for (i
= 0; i
< *size_ret
; i
++)
1879 if (*format_ret
== 32)
1880 (*((unsigned long **) data_ret
)) [i
]
1881 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1883 (*((unsigned short **) data_ret
)) [i
]
1884 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1888 Fsignal (Qerror
, /* Qselection_error */
1889 Fcons (build_string ("unrecognised selection data"),
1890 Fcons (obj
, Qnil
)));
1892 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1896 clean_local_selection_data (obj
)
1900 && INTEGERP (XCAR (obj
))
1901 && CONSP (XCDR (obj
))
1902 && INTEGERP (XCAR (XCDR (obj
)))
1903 && NILP (XCDR (XCDR (obj
))))
1904 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1907 && INTEGERP (XCAR (obj
))
1908 && INTEGERP (XCDR (obj
)))
1910 if (XINT (XCAR (obj
)) == 0)
1912 if (XINT (XCAR (obj
)) == -1)
1913 return make_number (- XINT (XCDR (obj
)));
1918 int size
= XVECTOR (obj
)->size
;
1921 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1922 copy
= Fmake_vector (make_number (size
), Qnil
);
1923 for (i
= 0; i
< size
; i
++)
1924 XVECTOR (copy
)->contents
[i
]
1925 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1931 /* Called from XTread_socket to handle SelectionNotify events.
1932 If it's the selection we are waiting for, stop waiting
1933 by setting the car of reading_selection_reply to non-nil.
1934 We store t there if the reply is successful, lambda if not. */
1937 x_handle_selection_notify (event
)
1938 XSelectionEvent
*event
;
1940 if (event
->requestor
!= reading_selection_window
)
1942 if (event
->selection
!= reading_which_selection
)
1945 TRACE0 ("Received SelectionNotify");
1946 XSETCAR (reading_selection_reply
,
1947 (event
->property
!= 0 ? Qt
: Qlambda
));
1951 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1952 Sx_own_selection_internal
, 2, 2, 0,
1953 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1954 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1955 \(Those are literal upper-case symbol names, since that's what X expects.)
1956 VALUE is typically a string, or a cons of two markers, but may be
1957 anything that the functions on `selection-converter-alist' know about. */)
1958 (selection_name
, selection_value
)
1959 Lisp_Object selection_name
, selection_value
;
1962 CHECK_SYMBOL (selection_name
);
1963 if (NILP (selection_value
)) error ("selection-value may not be nil");
1964 x_own_selection (selection_name
, selection_value
);
1965 return selection_value
;
1969 /* Request the selection value from the owner. If we are the owner,
1970 simply return our selection value. If we are not the owner, this
1971 will block until all of the data has arrived. */
1973 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1974 Sx_get_selection_internal
, 2, 3, 0,
1975 doc
: /* Return text selected from some X window.
1976 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1977 \(Those are literal upper-case symbol names, since that's what X expects.)
1978 TYPE is the type of data desired, typically `STRING'.
1979 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1980 selections. If omitted, defaults to the time for the last event. */)
1981 (selection_symbol
, target_type
, time_stamp
)
1982 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1984 Lisp_Object val
= Qnil
;
1985 struct gcpro gcpro1
, gcpro2
;
1986 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1988 CHECK_SYMBOL (selection_symbol
);
1990 #if 0 /* #### MULTIPLE doesn't work yet */
1991 if (CONSP (target_type
)
1992 && XCAR (target_type
) == QMULTIPLE
)
1994 CHECK_VECTOR (XCDR (target_type
));
1995 /* So we don't destructively modify this... */
1996 target_type
= copy_multiple_data (target_type
);
2000 CHECK_SYMBOL (target_type
);
2002 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2006 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2011 && SYMBOLP (XCAR (val
)))
2014 if (CONSP (val
) && NILP (XCDR (val
)))
2017 val
= clean_local_selection_data (val
);
2023 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2024 Sx_disown_selection_internal
, 1, 2, 0,
2025 doc
: /* If we own the selection SELECTION, disown it.
2026 Disowning it means there is no such selection. */)
2028 Lisp_Object selection
;
2032 Atom selection_atom
;
2033 struct selection_input_event event
;
2035 struct x_display_info
*dpyinfo
;
2036 struct frame
*sf
= SELECTED_FRAME ();
2039 if (! FRAME_X_P (sf
))
2042 display
= FRAME_X_DISPLAY (sf
);
2043 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2044 CHECK_SYMBOL (selection
);
2046 timestamp
= last_event_timestamp
;
2048 timestamp
= cons_to_long (time
);
2050 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2051 return Qnil
; /* Don't disown the selection when we're not the owner. */
2053 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2056 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2059 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2060 generated for a window which owns the selection when that window sets
2061 the selection owner to None. The NCD server does, the MIT Sun4 server
2062 doesn't. So we synthesize one; this means we might get two, but
2063 that's ok, because the second one won't have any effect. */
2064 SELECTION_EVENT_DISPLAY (&event
) = display
;
2065 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2066 SELECTION_EVENT_TIME (&event
) = timestamp
;
2067 x_handle_selection_clear ((struct input_event
*) &event
);
2072 /* Get rid of all the selections in buffer BUFFER.
2073 This is used when we kill a buffer. */
2076 x_disown_buffer_selections (buffer
)
2080 struct buffer
*buf
= XBUFFER (buffer
);
2082 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2084 Lisp_Object elt
, value
;
2087 if (CONSP (value
) && MARKERP (XCAR (value
))
2088 && XMARKER (XCAR (value
))->buffer
== buf
)
2089 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2093 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2095 doc
: /* Whether the current Emacs process owns the given X Selection.
2096 The arg should be the name of the selection in question, typically one of
2097 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2098 \(Those are literal upper-case symbol names, since that's what X expects.)
2099 For convenience, the symbol nil is the same as `PRIMARY',
2100 and t is the same as `SECONDARY'. */)
2102 Lisp_Object selection
;
2105 CHECK_SYMBOL (selection
);
2106 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2107 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2109 if (NILP (Fassq (selection
, Vselection_alist
)))
2114 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2116 doc
: /* Whether there is an owner for the given X Selection.
2117 The arg should be the name of the selection in question, typically one of
2118 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2119 \(Those are literal upper-case symbol names, since that's what X expects.)
2120 For convenience, the symbol nil is the same as `PRIMARY',
2121 and t is the same as `SECONDARY'. */)
2123 Lisp_Object selection
;
2128 struct frame
*sf
= SELECTED_FRAME ();
2130 /* It should be safe to call this before we have an X frame. */
2131 if (! FRAME_X_P (sf
))
2134 dpy
= FRAME_X_DISPLAY (sf
);
2135 CHECK_SYMBOL (selection
);
2136 if (!NILP (Fx_selection_owner_p (selection
)))
2138 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2139 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2140 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2144 owner
= XGetSelectionOwner (dpy
, atom
);
2146 return (owner
? Qt
: Qnil
);
2150 #ifdef CUT_BUFFER_SUPPORT
2152 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2154 initialize_cut_buffers (display
, window
)
2158 unsigned char *data
= (unsigned char *) "";
2160 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2161 PropModeAppend, data, 0)
2162 FROB (XA_CUT_BUFFER0
);
2163 FROB (XA_CUT_BUFFER1
);
2164 FROB (XA_CUT_BUFFER2
);
2165 FROB (XA_CUT_BUFFER3
);
2166 FROB (XA_CUT_BUFFER4
);
2167 FROB (XA_CUT_BUFFER5
);
2168 FROB (XA_CUT_BUFFER6
);
2169 FROB (XA_CUT_BUFFER7
);
2175 #define CHECK_CUT_BUFFER(symbol) \
2176 { CHECK_SYMBOL ((symbol)); \
2177 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2178 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2179 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2180 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2182 Fcons (build_string ("doesn't name a cut buffer"), \
2183 Fcons ((symbol), Qnil))); \
2186 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2187 Sx_get_cut_buffer_internal
, 1, 1, 0,
2188 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2194 unsigned char *data
;
2201 struct x_display_info
*dpyinfo
;
2202 struct frame
*sf
= SELECTED_FRAME ();
2206 if (! FRAME_X_P (sf
))
2209 display
= FRAME_X_DISPLAY (sf
);
2210 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2211 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2212 CHECK_CUT_BUFFER (buffer
);
2213 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2215 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2216 &type
, &format
, &size
, 0);
2217 if (!data
|| !format
)
2220 if (format
!= 8 || type
!= XA_STRING
)
2222 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2223 Fcons (x_atom_to_symbol (display
, type
),
2224 Fcons (make_number (format
), Qnil
))));
2226 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2227 /* Use xfree, not XFree, because x_get_window_property
2228 calls xmalloc itself. */
2234 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2235 Sx_store_cut_buffer_internal
, 2, 2, 0,
2236 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2238 Lisp_Object buffer
, string
;
2242 unsigned char *data
;
2244 int bytes_remaining
;
2247 struct frame
*sf
= SELECTED_FRAME ();
2251 if (! FRAME_X_P (sf
))
2254 display
= FRAME_X_DISPLAY (sf
);
2255 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2257 max_bytes
= SELECTION_QUANTUM (display
);
2258 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2259 max_bytes
= MAX_SELECTION_QUANTUM
;
2261 CHECK_CUT_BUFFER (buffer
);
2262 CHECK_STRING (string
);
2263 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2265 data
= (unsigned char *) SDATA (string
);
2266 bytes
= SBYTES (string
);
2267 bytes_remaining
= bytes
;
2269 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2271 initialize_cut_buffers (display
, window
);
2272 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2277 /* Don't mess up with an empty value. */
2278 if (!bytes_remaining
)
2279 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2280 PropModeReplace
, data
, 0);
2282 while (bytes_remaining
)
2284 int chunk
= (bytes_remaining
< max_bytes
2285 ? bytes_remaining
: max_bytes
);
2286 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2287 (bytes_remaining
== bytes
2292 bytes_remaining
-= chunk
;
2299 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2300 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2301 doc
: /* Rotate the values of the cut buffers by the given number of step.
2302 Positive means shift the values forward, negative means backward. */)
2309 struct frame
*sf
= SELECTED_FRAME ();
2313 if (! FRAME_X_P (sf
))
2316 display
= FRAME_X_DISPLAY (sf
);
2317 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2321 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2323 initialize_cut_buffers (display
, window
);
2324 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2327 props
[0] = XA_CUT_BUFFER0
;
2328 props
[1] = XA_CUT_BUFFER1
;
2329 props
[2] = XA_CUT_BUFFER2
;
2330 props
[3] = XA_CUT_BUFFER3
;
2331 props
[4] = XA_CUT_BUFFER4
;
2332 props
[5] = XA_CUT_BUFFER5
;
2333 props
[6] = XA_CUT_BUFFER6
;
2334 props
[7] = XA_CUT_BUFFER7
;
2336 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2343 /***********************************************************************
2344 Drag and drop support
2345 ***********************************************************************/
2346 /* Check that lisp values are of correct type for x_fill_property_data.
2347 That is, number, string or a cons with two numbers (low and high 16
2348 bit parts of a 32 bit number). */
2351 x_check_property_data (data
)
2357 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2359 Lisp_Object o
= XCAR (iter
);
2361 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2363 else if (CONSP (o
) &&
2364 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2371 /* Convert lisp values to a C array. Values may be a number, a string
2372 which is taken as an X atom name and converted to the atom value, or
2373 a cons containing the two 16 bit parts of a 32 bit number.
2375 DPY is the display use to look up X atoms.
2376 DATA is a Lisp list of values to be converted.
2377 RET is the C array that contains the converted values. It is assumed
2378 it is big enough to hol all values.
2379 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2380 be stored in RET. */
2383 x_fill_property_data (dpy
, data
, ret
, format
)
2390 CARD32
*d32
= (CARD32
*) ret
;
2391 CARD16
*d16
= (CARD16
*) ret
;
2392 CARD8
*d08
= (CARD8
*) ret
;
2395 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2397 Lisp_Object o
= XCAR (iter
);
2400 val
= (CARD32
) XFASTINT (o
);
2401 else if (FLOATP (o
))
2402 val
= (CARD32
) XFLOAT (o
);
2404 val
= (CARD32
) cons_to_long (o
);
2405 else if (STRINGP (o
))
2408 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2412 error ("Wrong type, must be string, number or cons");
2415 *d08
++ = (CARD8
) val
;
2416 else if (format
== 16)
2417 *d16
++ = (CARD16
) val
;
2423 /* Convert an array of C values to a Lisp list.
2424 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2425 DATA is a C array of values to be converted.
2426 TYPE is the type of the data. Only XA_ATOM is special, it converts
2427 each number in DATA to its corresponfing X atom as a symbol.
2428 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2430 SIZE is the number of elements in DATA.
2432 Also see comment for selection_data_to_lisp_data above. */
2435 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2437 unsigned char *data
;
2442 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2443 data
, size
*format
/8, type
, format
);
2446 /* Get the mouse position frame relative coordinates. */
2449 mouse_position_for_drop (f
, x
, y
)
2454 Window root
, dummy_window
;
2459 XQueryPointer (FRAME_X_DISPLAY (f
),
2460 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2462 /* The root window which contains the pointer. */
2465 /* Window pointer is on, not used */
2468 /* The position on that root window. */
2471 /* x/y in dummy_window coordinates, not used. */
2474 /* Modifier keys and pointer buttons, about which
2476 (unsigned int *) &dummy
);
2479 /* Absolute to relative. */
2480 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2481 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2486 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2487 Sx_get_atom_name
, 1, 2, 0,
2488 doc
: /* Return the X atom name for VALUE as a string.
2489 VALUE may be a number or a cons where the car is the upper 16 bits and
2490 the cdr is the lower 16 bits of a 32 bit value.
2491 Use the display for FRAME or the current frame if FRAME is not given or nil.
2493 If the value is 0 or the atom is not known, return the empty string. */)
2495 Lisp_Object value
, frame
;
2497 struct frame
*f
= check_x_frame (frame
);
2499 Lisp_Object ret
= Qnil
;
2501 Display
*dpy
= FRAME_X_DISPLAY (f
);
2504 if (INTEGERP (value
))
2505 atom
= (Atom
) XUINT (value
);
2506 else if (FLOATP (value
))
2507 atom
= (Atom
) XFLOAT (value
);
2508 else if (CONSP (value
))
2509 atom
= (Atom
) cons_to_long (value
);
2511 error ("Wrong type, value must be number or cons");
2514 count
= x_catch_errors (dpy
);
2516 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2518 if (! x_had_errors_p (dpy
))
2519 ret
= make_string (name
, strlen (name
));
2521 x_uncatch_errors (dpy
, count
);
2523 if (atom
&& name
) XFree (name
);
2524 if (NILP (ret
)) ret
= make_string ("", 0);
2531 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2532 TODO: Check if this client event really is a DND event? */
2535 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2537 XClientMessageEvent
*event
;
2538 struct x_display_info
*dpyinfo
;
2539 struct input_event
*bufp
;
2543 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2546 XSETFRAME (frame
, f
);
2548 vec
= Fmake_vector (make_number (4), Qnil
);
2549 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2550 event
->message_type
));
2551 AREF (vec
, 1) = frame
;
2552 AREF (vec
, 2) = make_number (event
->format
);
2553 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2555 event
->message_type
,
2559 mouse_position_for_drop (f
, &x
, &y
);
2560 bufp
->kind
= DRAG_N_DROP_EVENT
;
2561 bufp
->frame_or_window
= Fcons (frame
, vec
);
2562 bufp
->timestamp
= CurrentTime
;
2563 bufp
->x
= make_number (x
);
2564 bufp
->y
= make_number (y
);
2566 bufp
->modifiers
= 0;
2571 DEFUN ("x-send-client-message", Fx_send_client_event
,
2572 Sx_send_client_message
, 6, 6, 0,
2573 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2575 For DISPLAY, specify either a frame or a display name (a string).
2576 If DISPLAY is nil, that stands for the selected frame's display.
2577 DEST may be a number, in which case it is a Window id. The value 0 may
2578 be used to send to the root window of the DISPLAY.
2579 If DEST is a cons, it is converted to a 32 bit number
2580 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2581 number is then used as a window id.
2582 If DEST is a frame the event is sent to the outer window of that frame.
2583 Nil means the currently selected frame.
2584 If DEST is the string "PointerWindow" the event is sent to the window that
2585 contains the pointer. If DEST is the string "InputFocus" the event is
2586 sent to the window that has the input focus.
2587 FROM is the frame sending the event. Use nil for currently selected frame.
2588 MESSAGE-TYPE is the name of an Atom as a string.
2589 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2590 bits. VALUES is a list of numbers, cons and/or strings containing the values
2591 to send. If a value is a string, it is converted to an Atom and the value of
2592 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2593 with the high 16 bits from the car and the lower 16 bit from the cdr.
2594 If more values than fits into the event is given, the excessive values
2596 (display
, dest
, from
, message_type
, format
, values
)
2597 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2599 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2604 struct frame
*f
= check_x_frame (from
);
2608 CHECK_STRING (message_type
);
2609 CHECK_NUMBER (format
);
2610 CHECK_CONS (values
);
2612 if (x_check_property_data (values
) == -1)
2613 error ("Bad data in VALUES, must be number, cons or string");
2615 event
.xclient
.type
= ClientMessage
;
2616 event
.xclient
.format
= XFASTINT (format
);
2618 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2619 && event
.xclient
.format
!= 32)
2620 error ("FORMAT must be one of 8, 16 or 32");
2622 if (FRAMEP (dest
) || NILP (dest
))
2624 struct frame
*fdest
= check_x_frame (dest
);
2625 wdest
= FRAME_OUTER_WINDOW (fdest
);
2627 else if (STRINGP (dest
))
2629 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2630 wdest
= PointerWindow
;
2631 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2634 error ("DEST as a string must be one of PointerWindow or InputFocus");
2636 else if (INTEGERP (dest
))
2637 wdest
= (Window
) XFASTINT (dest
);
2638 else if (FLOATP (dest
))
2639 wdest
= (Window
) XFLOAT (dest
);
2640 else if (CONSP (dest
))
2642 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2643 error ("Both car and cdr for DEST must be numbers");
2645 wdest
= (Window
) cons_to_long (dest
);
2648 error ("DEST must be a frame, nil, string, number or cons");
2650 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2651 to_root
= wdest
== dpyinfo
->root_window
;
2653 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2658 event
.xclient
.message_type
2659 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2660 event
.xclient
.display
= dpyinfo
->display
;
2662 /* Some clients (metacity for example) expects sending window to be here
2663 when sending to the root window. */
2664 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2666 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2667 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2668 event
.xclient
.format
);
2670 /* If event mask is 0 the event is sent to the client that created
2671 the destination window. But if we are sending to the root window,
2672 there is no such client. Then we set the event mask to 0xffff. The
2673 event then goes to clients selecting for events on the root window. */
2674 count
= x_catch_errors (dpyinfo
->display
);
2676 int propagate
= to_root
? False
: True
;
2677 unsigned mask
= to_root
? 0xffff : 0;
2678 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2679 XFlush (dpyinfo
->display
);
2681 x_uncatch_errors (dpyinfo
->display
, count
);
2691 defsubr (&Sx_get_selection_internal
);
2692 defsubr (&Sx_own_selection_internal
);
2693 defsubr (&Sx_disown_selection_internal
);
2694 defsubr (&Sx_selection_owner_p
);
2695 defsubr (&Sx_selection_exists_p
);
2697 #ifdef CUT_BUFFER_SUPPORT
2698 defsubr (&Sx_get_cut_buffer_internal
);
2699 defsubr (&Sx_store_cut_buffer_internal
);
2700 defsubr (&Sx_rotate_cut_buffers_internal
);
2703 defsubr (&Sx_get_atom_name
);
2704 defsubr (&Sx_send_client_message
);
2706 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2707 staticpro (&reading_selection_reply
);
2708 reading_selection_window
= 0;
2709 reading_which_selection
= 0;
2711 property_change_wait_list
= 0;
2712 prop_location_identifier
= 0;
2713 property_change_reply
= Fcons (Qnil
, Qnil
);
2714 staticpro (&property_change_reply
);
2716 Vselection_alist
= Qnil
;
2717 staticpro (&Vselection_alist
);
2719 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2720 doc
: /* An alist associating X Windows selection-types with functions.
2721 These functions are called to convert the selection, with three args:
2722 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2723 a desired type to which the selection should be converted;
2724 and the local selection value (whatever was given to `x-own-selection').
2726 The function should return the value to send to the X server
2727 \(typically a string). A return value of nil
2728 means that the conversion could not be done.
2729 A return value which is the symbol `NULL'
2730 means that a side-effect was executed,
2731 and there is no meaningful selection value. */);
2732 Vselection_converter_alist
= Qnil
;
2734 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2735 doc
: /* A list of functions to be called when Emacs loses an X selection.
2736 \(This happens when some other X client makes its own selection
2737 or when a Lisp program explicitly clears the selection.)
2738 The functions are called with one argument, the selection type
2739 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2740 Vx_lost_selection_hooks
= Qnil
;
2742 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2743 doc
: /* A list of functions to be called when Emacs answers a selection request.
2744 The functions are called with four arguments:
2745 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2746 - the selection-type which Emacs was asked to convert the
2747 selection into before sending (for example, `STRING' or `LENGTH');
2748 - a flag indicating success or failure for responding to the request.
2749 We might have failed (and declined the request) for any number of reasons,
2750 including being asked for a selection that we no longer own, or being asked
2751 to convert into a type that we don't know about or that is inappropriate.
2752 This hook doesn't let you change the behavior of Emacs's selection replies,
2753 it merely informs you that they have happened. */);
2754 Vx_sent_selection_hooks
= Qnil
;
2756 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2757 doc
: /* Coding system for communicating with other X clients.
2758 When sending or receiving text via cut_buffer, selection, and clipboard,
2759 the text is encoded or decoded by this coding system.
2760 The default value is `compound-text-with-extensions'. */);
2761 Vselection_coding_system
= intern ("compound-text-with-extensions");
2763 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2764 doc
: /* Coding system for the next communication with other X clients.
2765 Usually, `selection-coding-system' is used for communicating with
2766 other X clients. But, if this variable is set, it is used for the
2767 next communication only. After the communication, this variable is
2769 Vnext_selection_coding_system
= Qnil
;
2771 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2772 doc
: /* Number of milliseconds to wait for a selection reply.
2773 If the selection owner doesn't reply in this time, we give up.
2774 A value of 0 means wait as long as necessary. This is initialized from the
2775 \"*selectionTimeout\" resource. */);
2776 x_selection_timeout
= 0;
2778 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2779 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2780 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2781 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2782 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2783 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2784 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2785 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2786 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2787 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2788 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2789 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2790 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2791 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2792 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2793 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2794 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2795 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2796 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2797 staticpro (&Qcompound_text_with_extensions
);
2799 #ifdef CUT_BUFFER_SUPPORT
2800 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2801 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2802 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2803 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2804 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2805 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2806 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2807 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2810 Qforeign_selection
= intern ("foreign-selection");
2811 staticpro (&Qforeign_selection
);
2814 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2815 (do not change this comment) */