1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Rewritten by jwz */
26 #include <stdio.h> /* termhooks.h needs this */
28 #include "xterm.h" /* for all of the X includes */
29 #include "dispextern.h" /* frame.h seems to want this */
30 #include "frame.h" /* Need this to get the X window of selected_frame */
31 #include "blockinput.h"
34 #include "termhooks.h"
36 #include <X11/Xproto.h>
40 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
41 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
43 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
44 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
45 static void x_decline_selection_request
P_ ((struct input_event
*));
46 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
47 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
48 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
49 static void x_reply_selection_request
P_ ((struct input_event
*, int,
50 unsigned char *, int, Atom
));
51 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
52 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
54 static void unexpect_property_change
P_ ((struct prop_location
*));
55 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
56 static void wait_for_property_change
P_ ((struct prop_location
*));
57 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
,
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. */
756 x_uncatch_errors (display
, count
);
760 /* Handle a SelectionRequest event EVENT.
761 This is called from keyboard.c when such an event is found in the queue. */
764 x_handle_selection_request (event
)
765 struct input_event
*event
;
767 struct gcpro gcpro1
, gcpro2
, gcpro3
;
768 Lisp_Object local_selection_data
;
769 Lisp_Object selection_symbol
;
770 Lisp_Object target_symbol
;
771 Lisp_Object converted_selection
;
772 Time local_selection_time
;
773 Lisp_Object successful_p
;
775 struct x_display_info
*dpyinfo
776 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
778 local_selection_data
= Qnil
;
779 target_symbol
= Qnil
;
780 converted_selection
= Qnil
;
783 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
785 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
786 SELECTION_EVENT_SELECTION (event
));
788 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
790 if (NILP (local_selection_data
))
792 /* Someone asked for the selection, but we don't have it any more.
794 x_decline_selection_request (event
);
798 local_selection_time
= (Time
)
799 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
801 if (SELECTION_EVENT_TIME (event
) != CurrentTime
802 && local_selection_time
> SELECTION_EVENT_TIME (event
))
804 /* Someone asked for the selection, and we have one, but not the one
807 x_decline_selection_request (event
);
811 x_selection_current_request
= event
;
812 count
= SPECPDL_INDEX ();
813 selection_request_dpyinfo
= dpyinfo
;
814 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
816 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
817 SELECTION_EVENT_TARGET (event
));
819 #if 0 /* #### MULTIPLE doesn't work yet */
820 if (EQ (target_symbol
, QMULTIPLE
))
821 target_symbol
= fetch_multiple_target (event
);
824 /* Convert lisp objects back into binary data */
827 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
829 if (! NILP (converted_selection
))
837 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
839 &data
, &type
, &size
, &format
, &nofree
);
841 x_reply_selection_request (event
, format
, data
, size
, type
);
844 /* Indicate we have successfully processed this event. */
845 x_selection_current_request
= 0;
847 /* Use xfree, not XFree, because lisp_data_to_selection_data
848 calls xmalloc itself. */
852 unbind_to (count
, Qnil
);
856 /* Let random lisp code notice that the selection has been asked for. */
859 rest
= Vx_sent_selection_hooks
;
860 if (!EQ (rest
, Qunbound
))
861 for (; CONSP (rest
); rest
= Fcdr (rest
))
862 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
868 /* Handle a SelectionClear event EVENT, which indicates that some
869 client cleared out our previously asserted selection.
870 This is called from keyboard.c when such an event is found in the queue. */
873 x_handle_selection_clear (event
)
874 struct input_event
*event
;
876 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
877 Atom selection
= SELECTION_EVENT_SELECTION (event
);
878 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
880 Lisp_Object selection_symbol
, local_selection_data
;
881 Time local_selection_time
;
882 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
883 struct x_display_info
*t_dpyinfo
;
885 /* If the new selection owner is also Emacs,
886 don't clear the new selection. */
888 /* Check each display on the same terminal,
889 to see if this Emacs job now owns the selection
890 through that display. */
891 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
892 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
895 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
896 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
904 selection_symbol
= x_atom_to_symbol (display
, selection
);
906 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
908 /* Well, we already believe that we don't own it, so that's just fine. */
909 if (NILP (local_selection_data
)) return;
911 local_selection_time
= (Time
)
912 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
914 /* This SelectionClear is for a selection that we no longer own, so we can
915 disregard it. (That is, we have reasserted the selection since this
916 request was generated.) */
918 if (changed_owner_time
!= CurrentTime
919 && local_selection_time
> changed_owner_time
)
922 /* Otherwise, we're really honest and truly being told to drop it.
923 Don't use Fdelq as that may QUIT;. */
925 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
926 Vselection_alist
= Fcdr (Vselection_alist
);
930 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
931 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
933 XSETCDR (rest
, Fcdr (XCDR (rest
)));
938 /* Let random lisp code notice that the selection has been stolen. */
942 rest
= Vx_lost_selection_hooks
;
943 if (!EQ (rest
, Qunbound
))
945 for (; CONSP (rest
); rest
= Fcdr (rest
))
946 call1 (Fcar (rest
), selection_symbol
);
947 prepare_menu_bars ();
948 redisplay_preserve_echo_area (20);
953 /* Clear all selections that were made from frame F.
954 We do this when about to delete a frame. */
957 x_clear_frame_selections (f
)
963 XSETFRAME (frame
, f
);
965 /* Otherwise, we're really honest and truly being told to drop it.
966 Don't use Fdelq as that may QUIT;. */
968 /* Delete elements from the beginning of Vselection_alist. */
969 while (!NILP (Vselection_alist
)
970 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
972 /* Let random Lisp code notice that the selection has been stolen. */
973 Lisp_Object hooks
, selection_symbol
;
975 hooks
= Vx_lost_selection_hooks
;
976 selection_symbol
= Fcar (Fcar (Vselection_alist
));
978 if (!EQ (hooks
, Qunbound
))
980 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
981 call1 (Fcar (hooks
), selection_symbol
);
982 #if 0 /* This can crash when deleting a frame
983 from x_connection_closed. Anyway, it seems unnecessary;
984 something else should cause a redisplay. */
985 redisplay_preserve_echo_area (21);
989 Vselection_alist
= Fcdr (Vselection_alist
);
992 /* Delete elements after the beginning of Vselection_alist. */
993 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
994 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
996 /* Let random Lisp code notice that the selection has been stolen. */
997 Lisp_Object hooks
, selection_symbol
;
999 hooks
= Vx_lost_selection_hooks
;
1000 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1002 if (!EQ (hooks
, Qunbound
))
1004 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1005 call1 (Fcar (hooks
), selection_symbol
);
1006 #if 0 /* See above */
1007 redisplay_preserve_echo_area (22);
1010 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1015 /* Nonzero if any properties for DISPLAY and WINDOW
1016 are on the list of what we are waiting for. */
1019 waiting_for_other_props_on_window (display
, window
)
1023 struct prop_location
*rest
= property_change_wait_list
;
1025 if (rest
->display
== display
&& rest
->window
== window
)
1032 /* Add an entry to the list of property changes we are waiting for.
1033 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1034 The return value is a number that uniquely identifies
1035 this awaited property change. */
1037 static struct prop_location
*
1038 expect_property_change (display
, window
, property
, state
)
1044 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1045 pl
->identifier
= ++prop_location_identifier
;
1046 pl
->display
= display
;
1047 pl
->window
= window
;
1048 pl
->property
= property
;
1049 pl
->desired_state
= state
;
1050 pl
->next
= property_change_wait_list
;
1052 property_change_wait_list
= pl
;
1056 /* Delete an entry from the list of property changes we are waiting for.
1057 IDENTIFIER is the number that uniquely identifies the entry. */
1060 unexpect_property_change (location
)
1061 struct prop_location
*location
;
1063 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1066 if (rest
== location
)
1069 prev
->next
= rest
->next
;
1071 property_change_wait_list
= rest
->next
;
1080 /* Remove the property change expectation element for IDENTIFIER. */
1083 wait_for_property_change_unwind (identifierval
)
1084 Lisp_Object identifierval
;
1086 unexpect_property_change ((struct prop_location
*)
1087 (XFASTINT (XCAR (identifierval
)) << 16
1088 | XFASTINT (XCDR (identifierval
))));
1092 /* Actually wait for a property change.
1093 IDENTIFIER should be the value that expect_property_change returned. */
1096 wait_for_property_change (location
)
1097 struct prop_location
*location
;
1100 int count
= SPECPDL_INDEX ();
1103 tem
= Fcons (Qnil
, Qnil
);
1104 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1105 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1107 /* Make sure to do unexpect_property_change if we quit or err. */
1108 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1110 XSETCAR (property_change_reply
, Qnil
);
1112 property_change_reply_object
= location
;
1113 /* If the event we are waiting for arrives beyond here, it will set
1114 property_change_reply, because property_change_reply_object says so. */
1115 if (! location
->arrived
)
1117 secs
= x_selection_timeout
/ 1000;
1118 usecs
= (x_selection_timeout
% 1000) * 1000;
1119 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1120 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1122 if (NILP (XCAR (property_change_reply
)))
1124 TRACE0 (" Timed out");
1125 error ("Timed out waiting for property-notify event");
1129 unbind_to (count
, Qnil
);
1132 /* Called from XTread_socket in response to a PropertyNotify event. */
1135 x_handle_property_notify (event
)
1136 XPropertyEvent
*event
;
1138 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1142 if (rest
->property
== event
->atom
1143 && rest
->window
== event
->window
1144 && rest
->display
== event
->display
1145 && rest
->desired_state
== event
->state
)
1147 TRACE2 ("Expected %s of property %s",
1148 (event
->state
== PropertyDelete
? "deletion" : "change"),
1149 XGetAtomName (event
->display
, event
->atom
));
1153 /* If this is the one wait_for_property_change is waiting for,
1154 tell it to wake up. */
1155 if (rest
== property_change_reply_object
)
1156 XSETCAR (property_change_reply
, Qt
);
1159 prev
->next
= rest
->next
;
1161 property_change_wait_list
= rest
->next
;
1173 #if 0 /* #### MULTIPLE doesn't work yet */
1176 fetch_multiple_target (event
)
1177 XSelectionRequestEvent
*event
;
1179 Display
*display
= event
->display
;
1180 Window window
= event
->requestor
;
1181 Atom target
= event
->target
;
1182 Atom selection_atom
= event
->selection
;
1187 x_get_window_property_as_lisp_data (display
, window
, target
,
1188 QMULTIPLE
, selection_atom
));
1192 copy_multiple_data (obj
)
1199 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1202 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1203 for (i
= 0; i
< size
; i
++)
1205 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1206 CHECK_VECTOR (vec2
);
1207 if (XVECTOR (vec2
)->size
!= 2)
1208 /* ??? Confusing error message */
1209 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1210 Fcons (vec2
, Qnil
)));
1211 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1212 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1213 = XVECTOR (vec2
)->contents
[0];
1214 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1215 = XVECTOR (vec2
)->contents
[1];
1223 /* Variables for communication with x_handle_selection_notify. */
1224 static Atom reading_which_selection
;
1225 static Lisp_Object reading_selection_reply
;
1226 static Window reading_selection_window
;
1228 /* Do protocol to read selection-data from the server.
1229 Converts this to Lisp data and returns it. */
1232 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1233 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1235 struct frame
*sf
= SELECTED_FRAME ();
1236 Window requestor_window
;
1238 struct x_display_info
*dpyinfo
;
1239 Time requestor_time
= last_event_timestamp
;
1240 Atom target_property
;
1241 Atom selection_atom
;
1247 if (! FRAME_X_P (sf
))
1250 requestor_window
= FRAME_X_WINDOW (sf
);
1251 display
= FRAME_X_DISPLAY (sf
);
1252 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1253 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1254 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1256 if (CONSP (target_type
))
1257 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1259 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1261 if (! NILP (time_stamp
))
1263 if (CONSP (time_stamp
))
1264 requestor_time
= (Time
) cons_to_long (time_stamp
);
1265 else if (INTEGERP (time_stamp
))
1266 requestor_time
= (Time
) XUINT (time_stamp
);
1267 else if (FLOATP (time_stamp
))
1268 requestor_time
= (Time
) XFLOAT (time_stamp
);
1270 error ("TIME_STAMP must be cons or number");
1275 count
= x_catch_errors (display
);
1277 TRACE2 ("Get selection %s, type %s",
1278 XGetAtomName (display
, type_atom
),
1279 XGetAtomName (display
, target_property
));
1281 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1282 requestor_window
, requestor_time
);
1285 /* Prepare to block until the reply has been read. */
1286 reading_selection_window
= requestor_window
;
1287 reading_which_selection
= selection_atom
;
1288 XSETCAR (reading_selection_reply
, Qnil
);
1290 frame
= some_frame_on_display (dpyinfo
);
1292 /* If the display no longer has frames, we can't expect
1293 to get many more selection requests from it, so don't
1294 bother trying to queue them. */
1297 x_start_queuing_selection_requests (display
);
1299 record_unwind_protect (queue_selection_requests_unwind
,
1304 /* This allows quits. Also, don't wait forever. */
1305 secs
= x_selection_timeout
/ 1000;
1306 usecs
= (x_selection_timeout
% 1000) * 1000;
1307 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1308 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1309 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1312 x_check_errors (display
, "Cannot get selection: %s");
1313 x_uncatch_errors (display
, count
);
1316 if (NILP (XCAR (reading_selection_reply
)))
1317 error ("Timed out waiting for reply from selection owner");
1318 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1319 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1321 /* Otherwise, the selection is waiting for us on the requested property. */
1323 x_get_window_property_as_lisp_data (display
, requestor_window
,
1324 target_property
, target_type
,
1328 /* Subroutines of x_get_window_property_as_lisp_data */
1330 /* Use xfree, not XFree, to free the data obtained with this function. */
1333 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1334 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1339 unsigned char **data_ret
;
1341 Atom
*actual_type_ret
;
1342 int *actual_format_ret
;
1343 unsigned long *actual_size_ret
;
1347 unsigned long bytes_remaining
;
1349 unsigned char *tmp_data
= 0;
1351 int buffer_size
= SELECTION_QUANTUM (display
);
1353 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1354 buffer_size
= MAX_SELECTION_QUANTUM
;
1358 /* First probe the thing to find out how big it is. */
1359 result
= XGetWindowProperty (display
, window
, property
,
1360 0L, 0L, False
, AnyPropertyType
,
1361 actual_type_ret
, actual_format_ret
,
1363 &bytes_remaining
, &tmp_data
);
1364 if (result
!= Success
)
1372 /* This was allocated by Xlib, so use XFree. */
1373 XFree ((char *) tmp_data
);
1375 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1381 total_size
= bytes_remaining
+ 1;
1382 *data_ret
= (unsigned char *) xmalloc (total_size
);
1384 /* Now read, until we've gotten it all. */
1385 while (bytes_remaining
)
1387 #ifdef TRACE_SELECTION
1388 int last
= bytes_remaining
;
1391 = XGetWindowProperty (display
, window
, property
,
1392 (long)offset
/4, (long)buffer_size
/4,
1395 actual_type_ret
, actual_format_ret
,
1396 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1398 TRACE2 ("Read %ld bytes from property %s",
1399 last
- bytes_remaining
,
1400 XGetAtomName (display
, property
));
1402 /* If this doesn't return Success at this point, it means that
1403 some clod deleted the selection while we were in the midst of
1404 reading it. Deal with that, I guess.... */
1405 if (result
!= Success
)
1407 *actual_size_ret
*= *actual_format_ret
/ 8;
1408 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1409 offset
+= *actual_size_ret
;
1411 /* This was allocated by Xlib, so use XFree. */
1412 XFree ((char *) tmp_data
);
1417 *bytes_ret
= offset
;
1420 /* Use xfree, not XFree, to free the data obtained with this function. */
1423 receive_incremental_selection (display
, window
, property
, target_type
,
1424 min_size_bytes
, data_ret
, size_bytes_ret
,
1425 type_ret
, format_ret
, size_ret
)
1429 Lisp_Object target_type
; /* for error messages only */
1430 unsigned int min_size_bytes
;
1431 unsigned char **data_ret
;
1432 int *size_bytes_ret
;
1434 unsigned long *size_ret
;
1438 struct prop_location
*wait_object
;
1439 *size_bytes_ret
= min_size_bytes
;
1440 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1442 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1444 /* At this point, we have read an INCR property.
1445 Delete the property to ack it.
1446 (But first, prepare to receive the next event in this handshake.)
1448 Now, we must loop, waiting for the sending window to put a value on
1449 that property, then reading the property, then deleting it to ack.
1450 We are done when the sender places a property of length 0.
1453 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1454 TRACE1 (" Delete property %s",
1455 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1456 XDeleteProperty (display
, window
, property
);
1457 TRACE1 (" Expect new value of property %s",
1458 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1459 wait_object
= expect_property_change (display
, window
, property
,
1466 unsigned char *tmp_data
;
1469 TRACE0 (" Wait for property change");
1470 wait_for_property_change (wait_object
);
1472 /* expect it again immediately, because x_get_window_property may
1473 .. no it won't, I don't get it.
1474 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1475 TRACE0 (" Get property value");
1476 x_get_window_property (display
, window
, property
,
1477 &tmp_data
, &tmp_size_bytes
,
1478 type_ret
, format_ret
, size_ret
, 1);
1480 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1482 if (tmp_size_bytes
== 0) /* we're done */
1484 TRACE0 ("Done reading incrementally");
1486 if (! waiting_for_other_props_on_window (display
, window
))
1487 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1488 unexpect_property_change (wait_object
);
1489 /* Use xfree, not XFree, because x_get_window_property
1490 calls xmalloc itself. */
1491 if (tmp_data
) xfree (tmp_data
);
1496 TRACE1 (" ACK by deleting property %s",
1497 XGetAtomName (display
, property
));
1498 XDeleteProperty (display
, window
, property
);
1499 wait_object
= expect_property_change (display
, window
, property
,
1504 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1506 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1507 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1510 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1511 offset
+= tmp_size_bytes
;
1513 /* Use xfree, not XFree, because x_get_window_property
1514 calls xmalloc itself. */
1520 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1521 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1522 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1525 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1530 Lisp_Object target_type
; /* for error messages only */
1531 Atom selection_atom
; /* for error messages only */
1535 unsigned long actual_size
;
1536 unsigned char *data
= 0;
1539 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1541 TRACE0 ("Reading selection data");
1543 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1544 &actual_type
, &actual_format
, &actual_size
, 1);
1547 int there_is_a_selection_owner
;
1549 there_is_a_selection_owner
1550 = XGetSelectionOwner (display
, selection_atom
);
1553 there_is_a_selection_owner
1554 ? Fcons (build_string ("selection owner couldn't convert"),
1556 ? Fcons (target_type
,
1557 Fcons (x_atom_to_symbol (display
,
1560 : Fcons (target_type
, Qnil
))
1561 : Fcons (build_string ("no selection"),
1562 Fcons (x_atom_to_symbol (display
,
1567 if (actual_type
== dpyinfo
->Xatom_INCR
)
1569 /* That wasn't really the data, just the beginning. */
1571 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1573 /* Use xfree, not XFree, because x_get_window_property
1574 calls xmalloc itself. */
1575 xfree ((char *) data
);
1577 receive_incremental_selection (display
, window
, property
, target_type
,
1578 min_size_bytes
, &data
, &bytes
,
1579 &actual_type
, &actual_format
,
1584 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1585 XDeleteProperty (display
, window
, property
);
1589 /* It's been read. Now convert it to a lisp object in some semi-rational
1591 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1592 actual_type
, actual_format
);
1594 /* Use xfree, not XFree, because x_get_window_property
1595 calls xmalloc itself. */
1596 xfree ((char *) data
);
1600 /* These functions convert from the selection data read from the server into
1601 something that we can use from Lisp, and vice versa.
1603 Type: Format: Size: Lisp Type:
1604 ----- ------- ----- -----------
1607 ATOM 32 > 1 Vector of Symbols
1609 * 16 > 1 Vector of Integers
1610 * 32 1 if <=16 bits: Integer
1611 if > 16 bits: Cons of top16, bot16
1612 * 32 > 1 Vector of the above
1614 When converting a Lisp number to C, it is assumed to be of format 16 if
1615 it is an integer, and of format 32 if it is a cons of two integers.
1617 When converting a vector of numbers from Lisp to C, it is assumed to be
1618 of format 16 if every element in the vector is an integer, and is assumed
1619 to be of format 32 if any element is a cons of two integers.
1621 When converting an object to C, it may be of the form (SYMBOL . <data>)
1622 where SYMBOL is what we should claim that the type is. Format and
1623 representation are as above. */
1628 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1630 unsigned char *data
;
1634 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1636 if (type
== dpyinfo
->Xatom_NULL
)
1639 /* Convert any 8-bit data to a string, for compactness. */
1640 else if (format
== 8)
1642 Lisp_Object str
, lispy_type
;
1644 str
= make_unibyte_string ((char *) data
, size
);
1645 /* Indicate that this string is from foreign selection by a text
1646 property `foreign-selection' so that the caller of
1647 x-get-selection-internal (usually x-get-selection) can know
1648 that the string must be decode. */
1649 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1650 lispy_type
= QCOMPOUND_TEXT
;
1651 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1652 lispy_type
= QUTF8_STRING
;
1654 lispy_type
= QSTRING
;
1655 Fput_text_property (make_number (0), make_number (size
),
1656 Qforeign_selection
, lispy_type
, str
);
1659 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1660 a vector of symbols.
1662 else if (type
== XA_ATOM
)
1665 if (size
== sizeof (Atom
))
1666 return x_atom_to_symbol (display
, *((Atom
*) data
));
1669 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1671 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1672 Faset (v
, make_number (i
),
1673 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1678 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1679 If the number is > 16 bits, convert it to a cons of integers,
1680 16 bits in each half.
1682 else if (format
== 32 && size
== sizeof (int))
1683 return long_to_cons (((unsigned int *) data
) [0]);
1684 else if (format
== 16 && size
== sizeof (short))
1685 return make_number ((int) (((unsigned short *) data
) [0]));
1687 /* Convert any other kind of data to a vector of numbers, represented
1688 as above (as an integer, or a cons of two 16 bit integers.)
1690 else if (format
== 16)
1694 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1695 for (i
= 0; i
< size
/ 2; i
++)
1697 int j
= (int) ((unsigned short *) data
) [i
];
1698 Faset (v
, make_number (i
), make_number (j
));
1705 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1706 for (i
= 0; i
< size
/ 4; i
++)
1708 unsigned int j
= ((unsigned int *) data
) [i
];
1709 Faset (v
, make_number (i
), long_to_cons (j
));
1716 /* Use xfree, not XFree, to free the data obtained with this function. */
1719 lisp_data_to_selection_data (display
, obj
,
1720 data_ret
, type_ret
, size_ret
,
1721 format_ret
, nofree_ret
)
1724 unsigned char **data_ret
;
1726 unsigned int *size_ret
;
1730 Lisp_Object type
= Qnil
;
1731 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1735 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1739 if (CONSP (obj
) && NILP (XCDR (obj
)))
1743 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1744 { /* This is not the same as declining */
1750 else if (STRINGP (obj
))
1752 xassert (! STRING_MULTIBYTE (obj
));
1756 *size_ret
= SBYTES (obj
);
1757 *data_ret
= SDATA (obj
);
1760 else if (SYMBOLP (obj
))
1764 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1765 (*data_ret
) [sizeof (Atom
)] = 0;
1766 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1767 if (NILP (type
)) type
= QATOM
;
1769 else if (INTEGERP (obj
)
1770 && XINT (obj
) < 0xFFFF
1771 && XINT (obj
) > -0xFFFF)
1775 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1776 (*data_ret
) [sizeof (short)] = 0;
1777 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1778 if (NILP (type
)) type
= QINTEGER
;
1780 else if (INTEGERP (obj
)
1781 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1782 && (INTEGERP (XCDR (obj
))
1783 || (CONSP (XCDR (obj
))
1784 && INTEGERP (XCAR (XCDR (obj
)))))))
1788 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1789 (*data_ret
) [sizeof (long)] = 0;
1790 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1791 if (NILP (type
)) type
= QINTEGER
;
1793 else if (VECTORP (obj
))
1795 /* Lisp_Vectors may represent a set of ATOMs;
1796 a set of 16 or 32 bit INTEGERs;
1797 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1801 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1802 /* This vector is an ATOM set */
1804 if (NILP (type
)) type
= QATOM
;
1805 *size_ret
= XVECTOR (obj
)->size
;
1807 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1808 for (i
= 0; i
< *size_ret
; i
++)
1809 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1810 (*(Atom
**) data_ret
) [i
]
1811 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1813 Fsignal (Qerror
, /* Qselection_error */
1815 ("all elements of selection vector must have same type"),
1816 Fcons (obj
, Qnil
)));
1818 #if 0 /* #### MULTIPLE doesn't work yet */
1819 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1820 /* This vector is an ATOM_PAIR set */
1822 if (NILP (type
)) type
= QATOM_PAIR
;
1823 *size_ret
= XVECTOR (obj
)->size
;
1825 *data_ret
= (unsigned char *)
1826 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1827 for (i
= 0; i
< *size_ret
; i
++)
1828 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1830 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1831 if (XVECTOR (pair
)->size
!= 2)
1834 ("elements of the vector must be vectors of exactly two elements"),
1835 Fcons (pair
, Qnil
)));
1837 (*(Atom
**) data_ret
) [i
* 2]
1838 = symbol_to_x_atom (dpyinfo
, display
,
1839 XVECTOR (pair
)->contents
[0]);
1840 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1841 = symbol_to_x_atom (dpyinfo
, display
,
1842 XVECTOR (pair
)->contents
[1]);
1847 ("all elements of the vector must be of the same type"),
1848 Fcons (obj
, Qnil
)));
1853 /* This vector is an INTEGER set, or something like it */
1855 *size_ret
= XVECTOR (obj
)->size
;
1856 if (NILP (type
)) type
= QINTEGER
;
1858 for (i
= 0; i
< *size_ret
; i
++)
1859 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1861 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1862 Fsignal (Qerror
, /* Qselection_error */
1864 ("elements of selection vector must be integers or conses of integers"),
1865 Fcons (obj
, Qnil
)));
1867 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1868 for (i
= 0; i
< *size_ret
; i
++)
1869 if (*format_ret
== 32)
1870 (*((unsigned long **) data_ret
)) [i
]
1871 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1873 (*((unsigned short **) data_ret
)) [i
]
1874 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1878 Fsignal (Qerror
, /* Qselection_error */
1879 Fcons (build_string ("unrecognised selection data"),
1880 Fcons (obj
, Qnil
)));
1882 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1886 clean_local_selection_data (obj
)
1890 && INTEGERP (XCAR (obj
))
1891 && CONSP (XCDR (obj
))
1892 && INTEGERP (XCAR (XCDR (obj
)))
1893 && NILP (XCDR (XCDR (obj
))))
1894 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1897 && INTEGERP (XCAR (obj
))
1898 && INTEGERP (XCDR (obj
)))
1900 if (XINT (XCAR (obj
)) == 0)
1902 if (XINT (XCAR (obj
)) == -1)
1903 return make_number (- XINT (XCDR (obj
)));
1908 int size
= XVECTOR (obj
)->size
;
1911 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1912 copy
= Fmake_vector (make_number (size
), Qnil
);
1913 for (i
= 0; i
< size
; i
++)
1914 XVECTOR (copy
)->contents
[i
]
1915 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1921 /* Called from XTread_socket to handle SelectionNotify events.
1922 If it's the selection we are waiting for, stop waiting
1923 by setting the car of reading_selection_reply to non-nil.
1924 We store t there if the reply is successful, lambda if not. */
1927 x_handle_selection_notify (event
)
1928 XSelectionEvent
*event
;
1930 if (event
->requestor
!= reading_selection_window
)
1932 if (event
->selection
!= reading_which_selection
)
1935 TRACE0 ("Received SelectionNotify");
1936 XSETCAR (reading_selection_reply
,
1937 (event
->property
!= 0 ? Qt
: Qlambda
));
1941 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1942 Sx_own_selection_internal
, 2, 2, 0,
1943 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1944 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1945 \(Those are literal upper-case symbol names, since that's what X expects.)
1946 VALUE is typically a string, or a cons of two markers, but may be
1947 anything that the functions on `selection-converter-alist' know about. */)
1948 (selection_name
, selection_value
)
1949 Lisp_Object selection_name
, selection_value
;
1952 CHECK_SYMBOL (selection_name
);
1953 if (NILP (selection_value
)) error ("selection-value may not be nil");
1954 x_own_selection (selection_name
, selection_value
);
1955 return selection_value
;
1959 /* Request the selection value from the owner. If we are the owner,
1960 simply return our selection value. If we are not the owner, this
1961 will block until all of the data has arrived. */
1963 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1964 Sx_get_selection_internal
, 2, 3, 0,
1965 doc
: /* Return text selected from some X window.
1966 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1967 \(Those are literal upper-case symbol names, since that's what X expects.)
1968 TYPE is the type of data desired, typically `STRING'.
1969 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1970 selections. If omitted, defaults to the time for the last event. */)
1971 (selection_symbol
, target_type
, time_stamp
)
1972 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1974 Lisp_Object val
= Qnil
;
1975 struct gcpro gcpro1
, gcpro2
;
1976 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1978 CHECK_SYMBOL (selection_symbol
);
1980 #if 0 /* #### MULTIPLE doesn't work yet */
1981 if (CONSP (target_type
)
1982 && XCAR (target_type
) == QMULTIPLE
)
1984 CHECK_VECTOR (XCDR (target_type
));
1985 /* So we don't destructively modify this... */
1986 target_type
= copy_multiple_data (target_type
);
1990 CHECK_SYMBOL (target_type
);
1992 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
1996 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2001 && SYMBOLP (XCAR (val
)))
2004 if (CONSP (val
) && NILP (XCDR (val
)))
2007 val
= clean_local_selection_data (val
);
2013 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2014 Sx_disown_selection_internal
, 1, 2, 0,
2015 doc
: /* If we own the selection SELECTION, disown it.
2016 Disowning it means there is no such selection. */)
2018 Lisp_Object selection
;
2022 Atom selection_atom
;
2023 struct selection_input_event event
;
2025 struct x_display_info
*dpyinfo
;
2026 struct frame
*sf
= SELECTED_FRAME ();
2029 if (! FRAME_X_P (sf
))
2032 display
= FRAME_X_DISPLAY (sf
);
2033 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2034 CHECK_SYMBOL (selection
);
2036 timestamp
= last_event_timestamp
;
2038 timestamp
= cons_to_long (time
);
2040 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2041 return Qnil
; /* Don't disown the selection when we're not the owner. */
2043 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2046 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2049 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2050 generated for a window which owns the selection when that window sets
2051 the selection owner to None. The NCD server does, the MIT Sun4 server
2052 doesn't. So we synthesize one; this means we might get two, but
2053 that's ok, because the second one won't have any effect. */
2054 SELECTION_EVENT_DISPLAY (&event
) = display
;
2055 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2056 SELECTION_EVENT_TIME (&event
) = timestamp
;
2057 x_handle_selection_clear ((struct input_event
*) &event
);
2062 /* Get rid of all the selections in buffer BUFFER.
2063 This is used when we kill a buffer. */
2066 x_disown_buffer_selections (buffer
)
2070 struct buffer
*buf
= XBUFFER (buffer
);
2072 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2074 Lisp_Object elt
, value
;
2077 if (CONSP (value
) && MARKERP (XCAR (value
))
2078 && XMARKER (XCAR (value
))->buffer
== buf
)
2079 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2083 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2085 doc
: /* Whether the current Emacs process owns the given X Selection.
2086 The arg should be the name of the selection in question, typically one of
2087 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2088 \(Those are literal upper-case symbol names, since that's what X expects.)
2089 For convenience, the symbol nil is the same as `PRIMARY',
2090 and t is the same as `SECONDARY'. */)
2092 Lisp_Object selection
;
2095 CHECK_SYMBOL (selection
);
2096 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2097 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2099 if (NILP (Fassq (selection
, Vselection_alist
)))
2104 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2106 doc
: /* Whether there is an owner for the given X Selection.
2107 The arg should be the name of the selection in question, typically one of
2108 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2109 \(Those are literal upper-case symbol names, since that's what X expects.)
2110 For convenience, the symbol nil is the same as `PRIMARY',
2111 and t is the same as `SECONDARY'. */)
2113 Lisp_Object selection
;
2118 struct frame
*sf
= SELECTED_FRAME ();
2120 /* It should be safe to call this before we have an X frame. */
2121 if (! FRAME_X_P (sf
))
2124 dpy
= FRAME_X_DISPLAY (sf
);
2125 CHECK_SYMBOL (selection
);
2126 if (!NILP (Fx_selection_owner_p (selection
)))
2128 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2129 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2130 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2134 owner
= XGetSelectionOwner (dpy
, atom
);
2136 return (owner
? Qt
: Qnil
);
2140 #ifdef CUT_BUFFER_SUPPORT
2142 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2144 initialize_cut_buffers (display
, window
)
2148 unsigned char *data
= (unsigned char *) "";
2150 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2151 PropModeAppend, data, 0)
2152 FROB (XA_CUT_BUFFER0
);
2153 FROB (XA_CUT_BUFFER1
);
2154 FROB (XA_CUT_BUFFER2
);
2155 FROB (XA_CUT_BUFFER3
);
2156 FROB (XA_CUT_BUFFER4
);
2157 FROB (XA_CUT_BUFFER5
);
2158 FROB (XA_CUT_BUFFER6
);
2159 FROB (XA_CUT_BUFFER7
);
2165 #define CHECK_CUT_BUFFER(symbol) \
2166 { CHECK_SYMBOL ((symbol)); \
2167 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2168 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2169 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2170 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2172 Fcons (build_string ("doesn't name a cut buffer"), \
2173 Fcons ((symbol), Qnil))); \
2176 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2177 Sx_get_cut_buffer_internal
, 1, 1, 0,
2178 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2184 unsigned char *data
;
2191 struct x_display_info
*dpyinfo
;
2192 struct frame
*sf
= SELECTED_FRAME ();
2196 if (! FRAME_X_P (sf
))
2199 display
= FRAME_X_DISPLAY (sf
);
2200 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2201 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2202 CHECK_CUT_BUFFER (buffer
);
2203 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2205 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2206 &type
, &format
, &size
, 0);
2207 if (!data
|| !format
)
2210 if (format
!= 8 || type
!= XA_STRING
)
2212 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2213 Fcons (x_atom_to_symbol (display
, type
),
2214 Fcons (make_number (format
), Qnil
))));
2216 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2217 /* Use xfree, not XFree, because x_get_window_property
2218 calls xmalloc itself. */
2224 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2225 Sx_store_cut_buffer_internal
, 2, 2, 0,
2226 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2228 Lisp_Object buffer
, string
;
2232 unsigned char *data
;
2234 int bytes_remaining
;
2237 struct frame
*sf
= SELECTED_FRAME ();
2241 if (! FRAME_X_P (sf
))
2244 display
= FRAME_X_DISPLAY (sf
);
2245 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2247 max_bytes
= SELECTION_QUANTUM (display
);
2248 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2249 max_bytes
= MAX_SELECTION_QUANTUM
;
2251 CHECK_CUT_BUFFER (buffer
);
2252 CHECK_STRING (string
);
2253 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2255 data
= (unsigned char *) SDATA (string
);
2256 bytes
= SBYTES (string
);
2257 bytes_remaining
= bytes
;
2259 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2261 initialize_cut_buffers (display
, window
);
2262 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2267 /* Don't mess up with an empty value. */
2268 if (!bytes_remaining
)
2269 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2270 PropModeReplace
, data
, 0);
2272 while (bytes_remaining
)
2274 int chunk
= (bytes_remaining
< max_bytes
2275 ? bytes_remaining
: max_bytes
);
2276 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2277 (bytes_remaining
== bytes
2282 bytes_remaining
-= chunk
;
2289 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2290 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2291 doc
: /* Rotate the values of the cut buffers by the given number of step.
2292 Positive means shift the values forward, negative means backward. */)
2299 struct frame
*sf
= SELECTED_FRAME ();
2303 if (! FRAME_X_P (sf
))
2306 display
= FRAME_X_DISPLAY (sf
);
2307 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2311 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2313 initialize_cut_buffers (display
, window
);
2314 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2317 props
[0] = XA_CUT_BUFFER0
;
2318 props
[1] = XA_CUT_BUFFER1
;
2319 props
[2] = XA_CUT_BUFFER2
;
2320 props
[3] = XA_CUT_BUFFER3
;
2321 props
[4] = XA_CUT_BUFFER4
;
2322 props
[5] = XA_CUT_BUFFER5
;
2323 props
[6] = XA_CUT_BUFFER6
;
2324 props
[7] = XA_CUT_BUFFER7
;
2326 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2333 /***********************************************************************
2334 Drag and drop support
2335 ***********************************************************************/
2336 /* Check that lisp values are of correct type for x_fill_property_data.
2337 That is, number, string or a cons with two numbers (low and high 16
2338 bit parts of a 32 bit number). */
2341 x_check_property_data (data
)
2347 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2349 Lisp_Object o
= XCAR (iter
);
2351 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2353 else if (CONSP (o
) &&
2354 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2361 /* Convert lisp values to a C array. Values may be a number, a string
2362 which is taken as an X atom name and converted to the atom value, or
2363 a cons containing the two 16 bit parts of a 32 bit number.
2365 DPY is the display use to look up X atoms.
2366 DATA is a Lisp list of values to be converted.
2367 RET is the C array that contains the converted values. It is assumed
2368 it is big enough to hol all values.
2369 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2370 be stored in RET. */
2373 x_fill_property_data (dpy
, data
, ret
, format
)
2380 CARD32
*d32
= (CARD32
*) ret
;
2381 CARD16
*d16
= (CARD16
*) ret
;
2382 CARD8
*d08
= (CARD8
*) ret
;
2385 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2387 Lisp_Object o
= XCAR (iter
);
2390 val
= (CARD32
) XFASTINT (o
);
2391 else if (FLOATP (o
))
2392 val
= (CARD32
) XFLOAT (o
);
2394 val
= (CARD32
) cons_to_long (o
);
2395 else if (STRINGP (o
))
2398 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2402 error ("Wrong type, must be string, number or cons");
2405 *d08
++ = (CARD8
) val
;
2406 else if (format
== 16)
2407 *d16
++ = (CARD16
) val
;
2413 /* Convert an array of C values to a Lisp list.
2414 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2415 DATA is a C array of values to be converted.
2416 TYPE is the type of the data. Only XA_ATOM is special, it converts
2417 each number in DATA to its corresponfing X atom as a symbol.
2418 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2420 SIZE is the number of elements in DATA.
2422 Also see comment for selection_data_to_lisp_data above. */
2425 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2427 unsigned char *data
;
2432 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2433 data
, size
*format
/8, type
, format
);
2436 /* Get the mouse position frame relative coordinates. */
2439 mouse_position_for_drop (f
, x
, y
)
2444 Window root
, dummy_window
;
2449 XQueryPointer (FRAME_X_DISPLAY (f
),
2450 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2452 /* The root window which contains the pointer. */
2455 /* Window pointer is on, not used */
2458 /* The position on that root window. */
2461 /* x/y in dummy_window coordinates, not used. */
2464 /* Modifier keys and pointer buttons, about which
2466 (unsigned int *) &dummy
);
2469 /* Absolute to relative. */
2470 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2471 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2476 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2477 Sx_get_atom_name
, 1, 2, 0,
2478 doc
: /* Return the X atom name for VALUE as a string.
2479 VALUE may be a number or a cons where the car is the upper 16 bits and
2480 the cdr is the lower 16 bits of a 32 bit value.
2481 Use the display for FRAME or the current frame if FRAME is not given or nil.
2483 If the value is 0 or the atom is not known, return the empty string. */)
2485 Lisp_Object value
, frame
;
2487 struct frame
*f
= check_x_frame (frame
);
2489 Lisp_Object ret
= Qnil
;
2491 Display
*dpy
= FRAME_X_DISPLAY (f
);
2494 if (INTEGERP (value
))
2495 atom
= (Atom
) XUINT (value
);
2496 else if (FLOATP (value
))
2497 atom
= (Atom
) XFLOAT (value
);
2498 else if (CONSP (value
))
2499 atom
= (Atom
) cons_to_long (value
);
2501 error ("Wrong type, value must be number or cons");
2504 count
= x_catch_errors (dpy
);
2506 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2508 if (! x_had_errors_p (dpy
))
2509 ret
= make_string (name
, strlen (name
));
2511 x_uncatch_errors (dpy
, count
);
2513 if (atom
&& name
) XFree (name
);
2514 if (NILP (ret
)) ret
= make_string ("", 0);
2521 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2522 TODO: Check if this client event really is a DND event? */
2525 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2527 XClientMessageEvent
*event
;
2528 struct x_display_info
*dpyinfo
;
2529 struct input_event
*bufp
;
2533 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2536 XSETFRAME (frame
, f
);
2538 vec
= Fmake_vector (make_number (4), Qnil
);
2539 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2540 event
->message_type
));
2541 AREF (vec
, 1) = frame
;
2542 AREF (vec
, 2) = make_number (event
->format
);
2543 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2545 event
->message_type
,
2549 mouse_position_for_drop (f
, &x
, &y
);
2550 bufp
->kind
= DRAG_N_DROP_EVENT
;
2551 bufp
->frame_or_window
= Fcons (frame
, vec
);
2552 bufp
->timestamp
= CurrentTime
;
2553 bufp
->x
= make_number (x
);
2554 bufp
->y
= make_number (y
);
2556 bufp
->modifiers
= 0;
2561 DEFUN ("x-send-client-message", Fx_send_client_event
,
2562 Sx_send_client_message
, 6, 6, 0,
2563 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2565 For DISPLAY, specify either a frame or a display name (a string).
2566 If DISPLAY is nil, that stands for the selected frame's display.
2567 DEST may be a number, in which case it is a Window id. The value 0 may
2568 be used to send to the root window of the DISPLAY.
2569 If DEST is a cons, it is converted to a 32 bit number
2570 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2571 number is then used as a window id.
2572 If DEST is a frame the event is sent to the outer window of that frame.
2573 Nil means the currently selected frame.
2574 If DEST is the string "PointerWindow" the event is sent to the window that
2575 contains the pointer. If DEST is the string "InputFocus" the event is
2576 sent to the window that has the input focus.
2577 FROM is the frame sending the event. Use nil for currently selected frame.
2578 MESSAGE-TYPE is the name of an Atom as a string.
2579 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2580 bits. VALUES is a list of numbers, cons and/or strings containing the values
2581 to send. If a value is a string, it is converted to an Atom and the value of
2582 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2583 with the high 16 bits from the car and the lower 16 bit from the cdr.
2584 If more values than fits into the event is given, the excessive values
2586 (display
, dest
, from
, message_type
, format
, values
)
2587 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2589 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2594 struct frame
*f
= check_x_frame (from
);
2598 CHECK_STRING (message_type
);
2599 CHECK_NUMBER (format
);
2600 CHECK_CONS (values
);
2602 if (x_check_property_data (values
) == -1)
2603 error ("Bad data in VALUES, must be number, cons or string");
2605 event
.xclient
.type
= ClientMessage
;
2606 event
.xclient
.format
= XFASTINT (format
);
2608 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2609 && event
.xclient
.format
!= 32)
2610 error ("FORMAT must be one of 8, 16 or 32");
2612 if (FRAMEP (dest
) || NILP (dest
))
2614 struct frame
*fdest
= check_x_frame (dest
);
2615 wdest
= FRAME_OUTER_WINDOW (fdest
);
2617 else if (STRINGP (dest
))
2619 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2620 wdest
= PointerWindow
;
2621 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2624 error ("DEST as a string must be one of PointerWindow or InputFocus");
2626 else if (INTEGERP (dest
))
2627 wdest
= (Window
) XFASTINT (dest
);
2628 else if (FLOATP (dest
))
2629 wdest
= (Window
) XFLOAT (dest
);
2630 else if (CONSP (dest
))
2632 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2633 error ("Both car and cdr for DEST must be numbers");
2635 wdest
= (Window
) cons_to_long (dest
);
2638 error ("DEST must be a frame, nil, string, number or cons");
2640 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2641 to_root
= wdest
== dpyinfo
->root_window
;
2643 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2648 event
.xclient
.message_type
2649 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2650 event
.xclient
.display
= dpyinfo
->display
;
2652 /* Some clients (metacity for example) expects sending window to be here
2653 when sending to the root window. */
2654 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2656 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2657 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2658 event
.xclient
.format
);
2660 /* If event mask is 0 the event is sent to the client that created
2661 the destination window. But if we are sending to the root window,
2662 there is no such client. Then we set the event mask to 0xffff. The
2663 event then goes to clients selecting for events on the root window. */
2664 count
= x_catch_errors (dpyinfo
->display
);
2666 int propagate
= to_root
? False
: True
;
2667 unsigned mask
= to_root
? 0xffff : 0;
2668 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2669 XFlush (dpyinfo
->display
);
2671 x_uncatch_errors (dpyinfo
->display
, count
);
2681 defsubr (&Sx_get_selection_internal
);
2682 defsubr (&Sx_own_selection_internal
);
2683 defsubr (&Sx_disown_selection_internal
);
2684 defsubr (&Sx_selection_owner_p
);
2685 defsubr (&Sx_selection_exists_p
);
2687 #ifdef CUT_BUFFER_SUPPORT
2688 defsubr (&Sx_get_cut_buffer_internal
);
2689 defsubr (&Sx_store_cut_buffer_internal
);
2690 defsubr (&Sx_rotate_cut_buffers_internal
);
2693 defsubr (&Sx_get_atom_name
);
2694 defsubr (&Sx_send_client_message
);
2696 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2697 staticpro (&reading_selection_reply
);
2698 reading_selection_window
= 0;
2699 reading_which_selection
= 0;
2701 property_change_wait_list
= 0;
2702 prop_location_identifier
= 0;
2703 property_change_reply
= Fcons (Qnil
, Qnil
);
2704 staticpro (&property_change_reply
);
2706 Vselection_alist
= Qnil
;
2707 staticpro (&Vselection_alist
);
2709 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2710 doc
: /* An alist associating X Windows selection-types with functions.
2711 These functions are called to convert the selection, with three args:
2712 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2713 a desired type to which the selection should be converted;
2714 and the local selection value (whatever was given to `x-own-selection').
2716 The function should return the value to send to the X server
2717 \(typically a string). A return value of nil
2718 means that the conversion could not be done.
2719 A return value which is the symbol `NULL'
2720 means that a side-effect was executed,
2721 and there is no meaningful selection value. */);
2722 Vselection_converter_alist
= Qnil
;
2724 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2725 doc
: /* A list of functions to be called when Emacs loses an X selection.
2726 \(This happens when some other X client makes its own selection
2727 or when a Lisp program explicitly clears the selection.)
2728 The functions are called with one argument, the selection type
2729 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2730 Vx_lost_selection_hooks
= Qnil
;
2732 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2733 doc
: /* A list of functions to be called when Emacs answers a selection request.
2734 The functions are called with four arguments:
2735 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2736 - the selection-type which Emacs was asked to convert the
2737 selection into before sending (for example, `STRING' or `LENGTH');
2738 - a flag indicating success or failure for responding to the request.
2739 We might have failed (and declined the request) for any number of reasons,
2740 including being asked for a selection that we no longer own, or being asked
2741 to convert into a type that we don't know about or that is inappropriate.
2742 This hook doesn't let you change the behavior of Emacs's selection replies,
2743 it merely informs you that they have happened. */);
2744 Vx_sent_selection_hooks
= Qnil
;
2746 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2747 doc
: /* Coding system for communicating with other X clients.
2748 When sending or receiving text via cut_buffer, selection, and clipboard,
2749 the text is encoded or decoded by this coding system.
2750 The default value is `compound-text-with-extensions'. */);
2751 Vselection_coding_system
= intern ("compound-text-with-extensions");
2753 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2754 doc
: /* Coding system for the next communication with other X clients.
2755 Usually, `selection-coding-system' is used for communicating with
2756 other X clients. But, if this variable is set, it is used for the
2757 next communication only. After the communication, this variable is
2759 Vnext_selection_coding_system
= Qnil
;
2761 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2762 doc
: /* Number of milliseconds to wait for a selection reply.
2763 If the selection owner doesn't reply in this time, we give up.
2764 A value of 0 means wait as long as necessary. This is initialized from the
2765 \"*selectionTimeout\" resource. */);
2766 x_selection_timeout
= 0;
2768 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2769 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2770 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2771 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2772 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2773 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2774 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2775 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2776 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2777 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2778 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2779 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2780 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2781 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2782 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2783 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2784 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2785 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2786 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2787 staticpro (&Qcompound_text_with_extensions
);
2789 #ifdef CUT_BUFFER_SUPPORT
2790 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2791 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2792 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2793 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2794 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2795 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2796 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2797 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2800 Qforeign_selection
= intern ("foreign-selection");
2801 staticpro (&Qforeign_selection
);
2804 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2805 (do not change this comment) */