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"
37 #include <X11/Xproto.h>
41 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
42 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
44 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
45 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
46 static void x_decline_selection_request
P_ ((struct input_event
*));
47 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
48 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
49 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
50 static void x_reply_selection_request
P_ ((struct input_event
*, int,
51 unsigned char *, int, Atom
));
52 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
53 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
55 static void unexpect_property_change
P_ ((struct prop_location
*));
56 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
57 static void wait_for_property_change
P_ ((struct prop_location
*));
58 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
,
61 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
62 unsigned char **, int *,
63 Atom
*, int *, unsigned long *, int));
64 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
65 Lisp_Object
, unsigned,
66 unsigned char **, int *,
67 Atom
*, int *, unsigned long *));
68 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
71 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
73 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
74 unsigned char **, Atom
*,
75 unsigned *, int *, int *));
76 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
77 static void initialize_cut_buffers
P_ ((Display
*, Window
));
80 /* Printing traces to stderr. */
82 #ifdef TRACE_SELECTION
84 fprintf (stderr, "%d: " fmt "\n", getpid ())
85 #define TRACE1(fmt, a0) \
86 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
87 #define TRACE2(fmt, a0, a1) \
88 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
89 #define TRACE3(fmt, a0, a1, a2) \
90 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
92 #define TRACE0(fmt) (void) 0
93 #define TRACE1(fmt, a0) (void) 0
94 #define TRACE2(fmt, a0, a1) (void) 0
95 #define TRACE3(fmt, a0, a1) (void) 0
99 #define CUT_BUFFER_SUPPORT
101 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
102 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
105 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
106 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
108 Lisp_Object Qcompound_text_with_extensions
;
110 #ifdef CUT_BUFFER_SUPPORT
111 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
112 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
115 static Lisp_Object Vx_lost_selection_functions
;
116 static Lisp_Object Vx_sent_selection_functions
;
117 /* Coding system for communicating with other X clients via cutbuffer,
118 selection, and clipboard. */
119 static Lisp_Object Vselection_coding_system
;
121 /* Coding system for the next communicating with other X clients. */
122 static Lisp_Object Vnext_selection_coding_system
;
124 static Lisp_Object Qforeign_selection
;
126 /* If this is a smaller number than the max-request-size of the display,
127 emacs will use INCR selection transfer when the selection is larger
128 than this. The max-request-size is usually around 64k, so if you want
129 emacs to use incremental selection transfers when the selection is
130 smaller than that, set this. I added this mostly for debugging the
131 incremental transfer stuff, but it might improve server performance. */
132 #define MAX_SELECTION_QUANTUM 0xFFFFFF
135 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
137 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
140 /* The timestamp of the last input event Emacs received from the X server. */
141 /* Defined in keyboard.c. */
142 extern unsigned long last_event_timestamp
;
144 /* This is an association list whose elements are of the form
145 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
146 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
147 SELECTION-VALUE is the value that emacs owns for that selection.
148 It may be any kind of Lisp object.
149 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
150 as a cons of two 16-bit numbers (making a 32 bit time.)
151 FRAME is the frame for which we made the selection.
152 If there is an entry in this alist, then it can be assumed that Emacs owns
154 The only (eq) parts of this list that are visible from Lisp are the
156 static Lisp_Object Vselection_alist
;
158 /* This is an alist whose CARs are selection-types (whose names are the same
159 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
160 call to convert the given Emacs selection value to a string representing
161 the given selection type. This is for Lisp-level extension of the emacs
162 selection handling. */
163 static Lisp_Object Vselection_converter_alist
;
165 /* If the selection owner takes too long to reply to a selection request,
166 we give up on it. This is in milliseconds (0 = no timeout.) */
167 static EMACS_INT x_selection_timeout
;
169 /* Utility functions */
171 static void lisp_data_to_selection_data ();
172 static Lisp_Object
selection_data_to_lisp_data ();
173 static Lisp_Object
x_get_window_property_as_lisp_data ();
177 /* Define a queue to save up SelectionRequest events for later handling. */
179 struct selection_event_queue
181 struct input_event event
;
182 struct selection_event_queue
*next
;
185 static struct selection_event_queue
*selection_queue
;
187 /* Nonzero means queue up certain events--don't process them yet. */
189 static int x_queue_selection_requests
;
191 /* Queue up an X event *EVENT, to be processed later. */
194 x_queue_event (event
)
195 struct input_event
*event
;
197 struct selection_event_queue
*queue_tmp
;
199 /* Don't queue repeated requests */
200 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
202 if (!bcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
204 TRACE1 ("IGNORE DUP SELECTION EVENT %08x", (unsigned long)queue_tmp
);
210 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
212 if (queue_tmp
!= NULL
)
214 TRACE1 ("QUEUE SELECTION EVENT %08x", (unsigned long)queue_tmp
);
215 queue_tmp
->event
= *event
;
216 queue_tmp
->next
= selection_queue
;
217 selection_queue
= queue_tmp
;
221 /* Start queuing SelectionRequest events. */
224 x_start_queuing_selection_requests ()
226 if (x_queue_selection_requests
)
229 x_queue_selection_requests
++;
230 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
233 /* Stop queuing SelectionRequest events. */
236 x_stop_queuing_selection_requests ()
238 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
239 --x_queue_selection_requests
;
241 /* Take all the queued events and put them back
242 so that they get processed afresh. */
244 while (selection_queue
!= NULL
)
246 struct selection_event_queue
*queue_tmp
= selection_queue
;
247 TRACE1 ("RESTORE SELECTION EVENT %08x", (unsigned long)queue_tmp
);
248 kbd_buffer_unget_event (&queue_tmp
->event
);
249 selection_queue
= queue_tmp
->next
;
250 xfree ((char *)queue_tmp
);
255 /* This converts a Lisp symbol to a server Atom, avoiding a server
256 roundtrip whenever possible. */
259 symbol_to_x_atom (dpyinfo
, display
, sym
)
260 struct x_display_info
*dpyinfo
;
265 if (NILP (sym
)) return 0;
266 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
267 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
268 if (EQ (sym
, QSTRING
)) return XA_STRING
;
269 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
270 if (EQ (sym
, QATOM
)) return XA_ATOM
;
271 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
272 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
273 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
274 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
275 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
276 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
277 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
278 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
279 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
280 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
281 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
282 #ifdef CUT_BUFFER_SUPPORT
283 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
284 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
285 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
286 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
287 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
288 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
289 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
290 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
292 if (!SYMBOLP (sym
)) abort ();
294 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
296 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
302 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
303 and calls to intern whenever possible. */
306 x_atom_to_symbol (dpy
, atom
)
310 struct x_display_info
*dpyinfo
;
329 #ifdef CUT_BUFFER_SUPPORT
349 dpyinfo
= x_display_info_for_display (dpy
);
350 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
352 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
354 if (atom
== dpyinfo
->Xatom_TEXT
)
356 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
357 return QCOMPOUND_TEXT
;
358 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
360 if (atom
== dpyinfo
->Xatom_DELETE
)
362 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
364 if (atom
== dpyinfo
->Xatom_INCR
)
366 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
368 if (atom
== dpyinfo
->Xatom_TARGETS
)
370 if (atom
== dpyinfo
->Xatom_NULL
)
374 str
= XGetAtomName (dpy
, atom
);
376 TRACE1 ("XGetAtomName --> %s", str
);
377 if (! str
) return Qnil
;
380 /* This was allocated by Xlib, so use XFree. */
386 /* Do protocol to assert ourself as a selection owner.
387 Update the Vselection_alist so that we can reply to later requests for
391 x_own_selection (selection_name
, selection_value
)
392 Lisp_Object selection_name
, selection_value
;
394 struct frame
*sf
= SELECTED_FRAME ();
395 Window selecting_window
= FRAME_X_WINDOW (sf
);
396 Display
*display
= FRAME_X_DISPLAY (sf
);
397 Time time
= last_event_timestamp
;
399 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
402 CHECK_SYMBOL (selection_name
);
403 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
406 count
= x_catch_errors (display
);
407 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
408 x_check_errors (display
, "Can't set selection: %s");
409 x_uncatch_errors (display
, count
);
412 /* Now update the local cache */
414 Lisp_Object selection_time
;
415 Lisp_Object selection_data
;
416 Lisp_Object prev_value
;
418 selection_time
= long_to_cons ((unsigned long) time
);
419 selection_data
= Fcons (selection_name
,
420 Fcons (selection_value
,
421 Fcons (selection_time
,
422 Fcons (selected_frame
, Qnil
))));
423 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
425 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
427 /* If we already owned the selection, remove the old selection data.
428 Perhaps we should destructively modify it instead.
429 Don't use Fdelq as that may QUIT. */
430 if (!NILP (prev_value
))
432 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
433 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
434 if (EQ (prev_value
, Fcar (XCDR (rest
))))
436 XSETCDR (rest
, Fcdr (XCDR (rest
)));
443 /* Given a selection-name and desired type, look up our local copy of
444 the selection value and convert it to the type.
445 The value is nil or a string.
446 This function is used both for remote requests (LOCAL_REQUEST is zero)
447 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
449 This calls random Lisp code, and may signal or gc. */
452 x_get_local_selection (selection_symbol
, target_type
, local_request
)
453 Lisp_Object selection_symbol
, target_type
;
456 Lisp_Object local_value
;
457 Lisp_Object handler_fn
, value
, type
, check
;
460 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
462 if (NILP (local_value
)) return Qnil
;
464 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
465 if (EQ (target_type
, QTIMESTAMP
))
468 value
= XCAR (XCDR (XCDR (local_value
)));
471 else if (EQ (target_type
, QDELETE
))
474 Fx_disown_selection_internal
476 XCAR (XCDR (XCDR (local_value
))));
481 #if 0 /* #### MULTIPLE doesn't work yet */
482 else if (CONSP (target_type
)
483 && XCAR (target_type
) == QMULTIPLE
)
488 pairs
= XCDR (target_type
);
489 size
= XVECTOR (pairs
)->size
;
490 /* If the target is MULTIPLE, then target_type looks like
491 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
492 We modify the second element of each pair in the vector and
493 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
495 for (i
= 0; i
< size
; i
++)
498 pair
= XVECTOR (pairs
)->contents
[i
];
499 XVECTOR (pair
)->contents
[1]
500 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
501 XVECTOR (pair
)->contents
[1],
509 /* Don't allow a quit within the converter.
510 When the user types C-g, he would be surprised
511 if by luck it came during a converter. */
512 count
= SPECPDL_INDEX ();
513 specbind (Qinhibit_quit
, Qt
);
515 CHECK_SYMBOL (target_type
);
516 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
517 /* gcpro is not needed here since nothing but HANDLER_FN
518 is live, and that ought to be a symbol. */
520 if (!NILP (handler_fn
))
521 value
= call3 (handler_fn
,
522 selection_symbol
, (local_request
? Qnil
: target_type
),
523 XCAR (XCDR (local_value
)));
526 unbind_to (count
, Qnil
);
529 /* Make sure this value is of a type that we could transmit
530 to another X client. */
534 && SYMBOLP (XCAR (value
)))
536 check
= XCDR (value
);
544 /* Check for a value that cons_to_long could handle. */
545 else if (CONSP (check
)
546 && INTEGERP (XCAR (check
))
547 && (INTEGERP (XCDR (check
))
549 (CONSP (XCDR (check
))
550 && INTEGERP (XCAR (XCDR (check
)))
551 && NILP (XCDR (XCDR (check
))))))
556 Fcons (build_string ("invalid data returned by selection-conversion function"),
557 Fcons (handler_fn
, Fcons (value
, Qnil
))));
560 /* Subroutines of x_reply_selection_request. */
562 /* Send a SelectionNotify event to the requestor with property=None,
563 meaning we were unable to do what they wanted. */
566 x_decline_selection_request (event
)
567 struct input_event
*event
;
569 XSelectionEvent reply
;
572 reply
.type
= SelectionNotify
;
573 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
574 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
575 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
576 reply
.time
= SELECTION_EVENT_TIME (event
);
577 reply
.target
= SELECTION_EVENT_TARGET (event
);
578 reply
.property
= None
;
580 /* The reason for the error may be that the receiver has
581 died in the meantime. Handle that case. */
583 count
= x_catch_errors (reply
.display
);
584 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
585 XFlush (reply
.display
);
586 x_uncatch_errors (reply
.display
, count
);
590 /* This is the selection request currently being processed.
591 It is set to zero when the request is fully processed. */
592 static struct input_event
*x_selection_current_request
;
594 /* Display info in x_selection_request. */
596 static struct x_display_info
*selection_request_dpyinfo
;
598 /* Used as an unwind-protect clause so that, if a selection-converter signals
599 an error, we tell the requester that we were unable to do what they wanted
600 before we throw to top-level or go into the debugger or whatever. */
603 x_selection_request_lisp_error (ignore
)
606 if (x_selection_current_request
!= 0
607 && selection_request_dpyinfo
->display
)
608 x_decline_selection_request (x_selection_current_request
);
613 /* This stuff is so that INCR selections are reentrant (that is, so we can
614 be servicing multiple INCR selection requests simultaneously.) I haven't
615 actually tested that yet. */
617 /* Keep a list of the property changes that are awaited. */
627 struct prop_location
*next
;
630 static struct prop_location
*expect_property_change ();
631 static void wait_for_property_change ();
632 static void unexpect_property_change ();
633 static int waiting_for_other_props_on_window ();
635 static int prop_location_identifier
;
637 static Lisp_Object property_change_reply
;
639 static struct prop_location
*property_change_reply_object
;
641 static struct prop_location
*property_change_wait_list
;
644 queue_selection_requests_unwind (tem
)
647 x_stop_queuing_selection_requests ();
651 /* Return some frame whose display info is DPYINFO.
652 Return nil if there is none. */
655 some_frame_on_display (dpyinfo
)
656 struct x_display_info
*dpyinfo
;
658 Lisp_Object list
, frame
;
660 FOR_EACH_FRAME (list
, frame
)
662 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
669 /* Send the reply to a selection request event EVENT.
670 TYPE is the type of selection data requested.
671 DATA and SIZE describe the data to send, already converted.
672 FORMAT is the unit-size (in bits) of the data to be transmitted. */
675 x_reply_selection_request (event
, format
, data
, size
, type
)
676 struct input_event
*event
;
681 XSelectionEvent reply
;
682 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
683 Window window
= SELECTION_EVENT_REQUESTOR (event
);
685 int format_bytes
= format
/8;
686 int max_bytes
= SELECTION_QUANTUM (display
);
687 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
690 if (max_bytes
> MAX_SELECTION_QUANTUM
)
691 max_bytes
= MAX_SELECTION_QUANTUM
;
693 reply
.type
= SelectionNotify
;
694 reply
.display
= display
;
695 reply
.requestor
= window
;
696 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
697 reply
.time
= SELECTION_EVENT_TIME (event
);
698 reply
.target
= SELECTION_EVENT_TARGET (event
);
699 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
700 if (reply
.property
== None
)
701 reply
.property
= reply
.target
;
703 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
705 count
= x_catch_errors (display
);
707 #ifdef TRACE_SELECTION
710 char *sel
= XGetAtomName (display
, reply
.selection
);
711 char *tgt
= XGetAtomName (display
, reply
.target
);
712 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++cnt
);
713 if (sel
) XFree (sel
);
714 if (tgt
) XFree (tgt
);
716 #endif /* TRACE_SELECTION */
718 /* Store the data on the requested property.
719 If the selection is large, only store the first N bytes of it.
721 bytes_remaining
= size
* format_bytes
;
722 if (bytes_remaining
<= max_bytes
)
724 /* Send all the data at once, with minimal handshaking. */
725 TRACE1 ("Sending all %d bytes", bytes_remaining
);
726 XChangeProperty (display
, window
, reply
.property
, type
, format
,
727 PropModeReplace
, data
, size
);
728 /* At this point, the selection was successfully stored; ack it. */
729 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
733 /* Send an INCR selection. */
734 struct prop_location
*wait_object
;
738 frame
= some_frame_on_display (dpyinfo
);
740 /* If the display no longer has frames, we can't expect
741 to get many more selection requests from it, so don't
742 bother trying to queue them. */
745 x_start_queuing_selection_requests ();
747 record_unwind_protect (queue_selection_requests_unwind
,
751 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
752 error ("Attempt to transfer an INCR to ourself!");
754 TRACE2 ("Start sending %d bytes incrementally (%s)",
755 bytes_remaining
, XGetAtomName (display
, reply
.property
));
756 wait_object
= expect_property_change (display
, window
, reply
.property
,
759 TRACE1 ("Set %s to number of bytes to send",
760 XGetAtomName (display
, reply
.property
));
761 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
763 (unsigned char *) &bytes_remaining
, 1);
764 XSelectInput (display
, window
, PropertyChangeMask
);
766 /* Tell 'em the INCR data is there... */
767 TRACE0 ("Send SelectionNotify event");
768 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
771 had_errors
= x_had_errors_p (display
);
774 /* First, wait for the requester to ack by deleting the property.
775 This can run random lisp code (process handlers) or signal. */
778 TRACE1 ("Waiting for ACK (deletion of %s)",
779 XGetAtomName (display
, reply
.property
));
780 wait_for_property_change (wait_object
);
783 unexpect_property_change (wait_object
);
786 while (bytes_remaining
)
788 int i
= ((bytes_remaining
< max_bytes
)
795 = expect_property_change (display
, window
, reply
.property
,
798 TRACE1 ("Sending increment of %d bytes", i
);
799 TRACE1 ("Set %s to increment data",
800 XGetAtomName (display
, reply
.property
));
802 /* Append the next chunk of data to the property. */
803 XChangeProperty (display
, window
, reply
.property
, type
, format
,
804 PropModeAppend
, data
, i
/ format_bytes
);
805 bytes_remaining
-= i
;
808 had_errors
= x_had_errors_p (display
);
814 /* Now wait for the requester to ack this chunk by deleting the
815 property. This can run random lisp code or signal. */
816 TRACE1 ("Waiting for increment ACK (deletion of %s)",
817 XGetAtomName (display
, reply
.property
));
818 wait_for_property_change (wait_object
);
821 /* Now write a zero-length chunk to the property to tell the
822 requester that we're done. */
824 if (! waiting_for_other_props_on_window (display
, window
))
825 XSelectInput (display
, window
, 0L);
827 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
828 XGetAtomName (display
, reply
.property
));
829 XChangeProperty (display
, window
, reply
.property
, type
, format
,
830 PropModeReplace
, data
, 0);
831 TRACE0 ("Done sending incrementally");
834 /* rms, 2003-01-03: I think I have fixed this bug. */
835 /* The window we're communicating with may have been deleted
836 in the meantime (that's a real situation from a bug report).
837 In this case, there may be events in the event queue still
838 refering to the deleted window, and we'll get a BadWindow error
839 in XTread_socket when processing the events. I don't have
840 an idea how to fix that. gerd, 2001-01-98. */
841 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
842 delivered before uncatch errors. */
843 XSync (display
, False
);
846 /* GTK queues events in addition to the queue in Xlib. So we
847 UNBLOCK to enter the event loop and get possible errors delivered,
848 and then BLOCK again because x_uncatch_errors requires it. */
850 x_uncatch_errors (display
, count
);
854 /* Handle a SelectionRequest event EVENT.
855 This is called from keyboard.c when such an event is found in the queue. */
858 x_handle_selection_request (event
)
859 struct input_event
*event
;
861 struct gcpro gcpro1
, gcpro2
, gcpro3
;
862 Lisp_Object local_selection_data
;
863 Lisp_Object selection_symbol
;
864 Lisp_Object target_symbol
;
865 Lisp_Object converted_selection
;
866 Time local_selection_time
;
867 Lisp_Object successful_p
;
869 struct x_display_info
*dpyinfo
870 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
872 TRACE0 ("x_handle_selection_request");
874 local_selection_data
= Qnil
;
875 target_symbol
= Qnil
;
876 converted_selection
= Qnil
;
879 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
881 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
882 SELECTION_EVENT_SELECTION (event
));
884 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
886 if (NILP (local_selection_data
))
888 /* Someone asked for the selection, but we don't have it any more.
890 x_decline_selection_request (event
);
894 local_selection_time
= (Time
)
895 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
897 if (SELECTION_EVENT_TIME (event
) != CurrentTime
898 && local_selection_time
> SELECTION_EVENT_TIME (event
))
900 /* Someone asked for the selection, and we have one, but not the one
903 x_decline_selection_request (event
);
907 x_selection_current_request
= event
;
908 count
= SPECPDL_INDEX ();
909 selection_request_dpyinfo
= dpyinfo
;
910 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
912 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
913 SELECTION_EVENT_TARGET (event
));
915 #if 0 /* #### MULTIPLE doesn't work yet */
916 if (EQ (target_symbol
, QMULTIPLE
))
917 target_symbol
= fetch_multiple_target (event
);
920 /* Convert lisp objects back into binary data */
923 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
925 if (! NILP (converted_selection
))
933 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
935 &data
, &type
, &size
, &format
, &nofree
);
937 x_reply_selection_request (event
, format
, data
, size
, type
);
940 /* Indicate we have successfully processed this event. */
941 x_selection_current_request
= 0;
943 /* Use xfree, not XFree, because lisp_data_to_selection_data
944 calls xmalloc itself. */
948 unbind_to (count
, Qnil
);
952 /* Let random lisp code notice that the selection has been asked for. */
955 rest
= Vx_sent_selection_functions
;
956 if (!EQ (rest
, Qunbound
))
957 for (; CONSP (rest
); rest
= Fcdr (rest
))
958 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
964 /* Handle a SelectionClear event EVENT, which indicates that some
965 client cleared out our previously asserted selection.
966 This is called from keyboard.c when such an event is found in the queue. */
969 x_handle_selection_clear (event
)
970 struct input_event
*event
;
972 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
973 Atom selection
= SELECTION_EVENT_SELECTION (event
);
974 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
976 Lisp_Object selection_symbol
, local_selection_data
;
977 Time local_selection_time
;
978 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
979 struct x_display_info
*t_dpyinfo
;
981 TRACE0 ("x_handle_selection_clear");
983 /* If the new selection owner is also Emacs,
984 don't clear the new selection. */
986 /* Check each display on the same terminal,
987 to see if this Emacs job now owns the selection
988 through that display. */
989 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
990 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
993 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
994 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
1002 selection_symbol
= x_atom_to_symbol (display
, selection
);
1004 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
1006 /* Well, we already believe that we don't own it, so that's just fine. */
1007 if (NILP (local_selection_data
)) return;
1009 local_selection_time
= (Time
)
1010 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
1012 /* This SelectionClear is for a selection that we no longer own, so we can
1013 disregard it. (That is, we have reasserted the selection since this
1014 request was generated.) */
1016 if (changed_owner_time
!= CurrentTime
1017 && local_selection_time
> changed_owner_time
)
1020 /* Otherwise, we're really honest and truly being told to drop it.
1021 Don't use Fdelq as that may QUIT;. */
1023 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
1024 Vselection_alist
= Fcdr (Vselection_alist
);
1028 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1029 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
1031 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1036 /* Let random lisp code notice that the selection has been stolen. */
1040 rest
= Vx_lost_selection_functions
;
1041 if (!EQ (rest
, Qunbound
))
1043 for (; CONSP (rest
); rest
= Fcdr (rest
))
1044 call1 (Fcar (rest
), selection_symbol
);
1045 prepare_menu_bars ();
1046 redisplay_preserve_echo_area (20);
1052 x_handle_selection_event (event
)
1053 struct input_event
*event
;
1055 TRACE0 ("x_handle_selection_event");
1057 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1059 if (x_queue_selection_requests
)
1060 x_queue_event (event
);
1062 x_handle_selection_request (event
);
1065 x_handle_selection_clear (event
);
1069 /* Clear all selections that were made from frame F.
1070 We do this when about to delete a frame. */
1073 x_clear_frame_selections (f
)
1079 XSETFRAME (frame
, f
);
1081 /* Otherwise, we're really honest and truly being told to drop it.
1082 Don't use Fdelq as that may QUIT;. */
1084 /* Delete elements from the beginning of Vselection_alist. */
1085 while (!NILP (Vselection_alist
)
1086 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1088 /* Let random Lisp code notice that the selection has been stolen. */
1089 Lisp_Object hooks
, selection_symbol
;
1091 hooks
= Vx_lost_selection_functions
;
1092 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1094 if (!EQ (hooks
, Qunbound
))
1096 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1097 call1 (Fcar (hooks
), selection_symbol
);
1098 #if 0 /* This can crash when deleting a frame
1099 from x_connection_closed. Anyway, it seems unnecessary;
1100 something else should cause a redisplay. */
1101 redisplay_preserve_echo_area (21);
1105 Vselection_alist
= Fcdr (Vselection_alist
);
1108 /* Delete elements after the beginning of Vselection_alist. */
1109 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1110 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1112 /* Let random Lisp code notice that the selection has been stolen. */
1113 Lisp_Object hooks
, selection_symbol
;
1115 hooks
= Vx_lost_selection_functions
;
1116 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1118 if (!EQ (hooks
, Qunbound
))
1120 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1121 call1 (Fcar (hooks
), selection_symbol
);
1122 #if 0 /* See above */
1123 redisplay_preserve_echo_area (22);
1126 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1131 /* Nonzero if any properties for DISPLAY and WINDOW
1132 are on the list of what we are waiting for. */
1135 waiting_for_other_props_on_window (display
, window
)
1139 struct prop_location
*rest
= property_change_wait_list
;
1141 if (rest
->display
== display
&& rest
->window
== window
)
1148 /* Add an entry to the list of property changes we are waiting for.
1149 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1150 The return value is a number that uniquely identifies
1151 this awaited property change. */
1153 static struct prop_location
*
1154 expect_property_change (display
, window
, property
, state
)
1160 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1161 pl
->identifier
= ++prop_location_identifier
;
1162 pl
->display
= display
;
1163 pl
->window
= window
;
1164 pl
->property
= property
;
1165 pl
->desired_state
= state
;
1166 pl
->next
= property_change_wait_list
;
1168 property_change_wait_list
= pl
;
1172 /* Delete an entry from the list of property changes we are waiting for.
1173 IDENTIFIER is the number that uniquely identifies the entry. */
1176 unexpect_property_change (location
)
1177 struct prop_location
*location
;
1179 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1182 if (rest
== location
)
1185 prev
->next
= rest
->next
;
1187 property_change_wait_list
= rest
->next
;
1196 /* Remove the property change expectation element for IDENTIFIER. */
1199 wait_for_property_change_unwind (loc
)
1202 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1204 unexpect_property_change (location
);
1205 if (location
== property_change_reply_object
)
1206 property_change_reply_object
= 0;
1210 /* Actually wait for a property change.
1211 IDENTIFIER should be the value that expect_property_change returned. */
1214 wait_for_property_change (location
)
1215 struct prop_location
*location
;
1218 int count
= SPECPDL_INDEX ();
1220 if (property_change_reply_object
)
1223 /* Make sure to do unexpect_property_change if we quit or err. */
1224 record_unwind_protect (wait_for_property_change_unwind
,
1225 make_save_value (location
, 0));
1227 XSETCAR (property_change_reply
, Qnil
);
1228 property_change_reply_object
= location
;
1230 /* If the event we are waiting for arrives beyond here, it will set
1231 property_change_reply, because property_change_reply_object says so. */
1232 if (! location
->arrived
)
1234 secs
= x_selection_timeout
/ 1000;
1235 usecs
= (x_selection_timeout
% 1000) * 1000;
1236 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1237 wait_reading_process_output (secs
, usecs
, 0, 0,
1238 property_change_reply
, NULL
, 0);
1240 if (NILP (XCAR (property_change_reply
)))
1242 TRACE0 (" Timed out");
1243 error ("Timed out waiting for property-notify event");
1247 unbind_to (count
, Qnil
);
1250 /* Called from XTread_socket in response to a PropertyNotify event. */
1253 x_handle_property_notify (event
)
1254 XPropertyEvent
*event
;
1256 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1261 && rest
->property
== event
->atom
1262 && rest
->window
== event
->window
1263 && rest
->display
== event
->display
1264 && rest
->desired_state
== event
->state
)
1266 TRACE2 ("Expected %s of property %s",
1267 (event
->state
== PropertyDelete
? "deletion" : "change"),
1268 XGetAtomName (event
->display
, event
->atom
));
1272 /* If this is the one wait_for_property_change is waiting for,
1273 tell it to wake up. */
1274 if (rest
== property_change_reply_object
)
1275 XSETCAR (property_change_reply
, Qt
);
1287 #if 0 /* #### MULTIPLE doesn't work yet */
1290 fetch_multiple_target (event
)
1291 XSelectionRequestEvent
*event
;
1293 Display
*display
= event
->display
;
1294 Window window
= event
->requestor
;
1295 Atom target
= event
->target
;
1296 Atom selection_atom
= event
->selection
;
1301 x_get_window_property_as_lisp_data (display
, window
, target
,
1302 QMULTIPLE
, selection_atom
));
1306 copy_multiple_data (obj
)
1313 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1316 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1317 for (i
= 0; i
< size
; i
++)
1319 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1320 CHECK_VECTOR (vec2
);
1321 if (XVECTOR (vec2
)->size
!= 2)
1322 /* ??? Confusing error message */
1323 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1324 Fcons (vec2
, Qnil
)));
1325 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1326 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1327 = XVECTOR (vec2
)->contents
[0];
1328 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1329 = XVECTOR (vec2
)->contents
[1];
1337 /* Variables for communication with x_handle_selection_notify. */
1338 static Atom reading_which_selection
;
1339 static Lisp_Object reading_selection_reply
;
1340 static Window reading_selection_window
;
1342 /* Do protocol to read selection-data from the server.
1343 Converts this to Lisp data and returns it. */
1346 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1347 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1349 struct frame
*sf
= SELECTED_FRAME ();
1350 Window requestor_window
= FRAME_X_WINDOW (sf
);
1351 Display
*display
= FRAME_X_DISPLAY (sf
);
1352 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1353 Time requestor_time
= last_event_timestamp
;
1354 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1355 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1361 if (CONSP (target_type
))
1362 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1364 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1366 if (! NILP (time_stamp
))
1368 if (CONSP (time_stamp
))
1369 requestor_time
= (Time
) cons_to_long (time_stamp
);
1370 else if (INTEGERP (time_stamp
))
1371 requestor_time
= (Time
) XUINT (time_stamp
);
1372 else if (FLOATP (time_stamp
))
1373 requestor_time
= (Time
) XFLOAT (time_stamp
);
1375 error ("TIME_STAMP must be cons or number");
1380 count
= x_catch_errors (display
);
1382 TRACE2 ("Get selection %s, type %s",
1383 XGetAtomName (display
, type_atom
),
1384 XGetAtomName (display
, target_property
));
1386 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1387 requestor_window
, requestor_time
);
1390 /* Prepare to block until the reply has been read. */
1391 reading_selection_window
= requestor_window
;
1392 reading_which_selection
= selection_atom
;
1393 XSETCAR (reading_selection_reply
, Qnil
);
1395 frame
= some_frame_on_display (dpyinfo
);
1397 /* If the display no longer has frames, we can't expect
1398 to get many more selection requests from it, so don't
1399 bother trying to queue them. */
1402 x_start_queuing_selection_requests ();
1404 record_unwind_protect (queue_selection_requests_unwind
,
1409 /* This allows quits. Also, don't wait forever. */
1410 secs
= x_selection_timeout
/ 1000;
1411 usecs
= (x_selection_timeout
% 1000) * 1000;
1412 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1413 wait_reading_process_output (secs
, usecs
, 0, 0,
1414 reading_selection_reply
, NULL
, 0);
1415 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1418 x_check_errors (display
, "Cannot get selection: %s");
1419 x_uncatch_errors (display
, count
);
1422 if (NILP (XCAR (reading_selection_reply
)))
1423 error ("Timed out waiting for reply from selection owner");
1424 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1425 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1427 /* Otherwise, the selection is waiting for us on the requested property. */
1429 x_get_window_property_as_lisp_data (display
, requestor_window
,
1430 target_property
, target_type
,
1434 /* Subroutines of x_get_window_property_as_lisp_data */
1436 /* Use xfree, not XFree, to free the data obtained with this function. */
1439 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1440 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1445 unsigned char **data_ret
;
1447 Atom
*actual_type_ret
;
1448 int *actual_format_ret
;
1449 unsigned long *actual_size_ret
;
1453 unsigned long bytes_remaining
;
1455 unsigned char *tmp_data
= 0;
1457 int buffer_size
= SELECTION_QUANTUM (display
);
1459 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1460 buffer_size
= MAX_SELECTION_QUANTUM
;
1464 /* First probe the thing to find out how big it is. */
1465 result
= XGetWindowProperty (display
, window
, property
,
1466 0L, 0L, False
, AnyPropertyType
,
1467 actual_type_ret
, actual_format_ret
,
1469 &bytes_remaining
, &tmp_data
);
1470 if (result
!= Success
)
1478 /* This was allocated by Xlib, so use XFree. */
1479 XFree ((char *) tmp_data
);
1481 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1487 total_size
= bytes_remaining
+ 1;
1488 *data_ret
= (unsigned char *) xmalloc (total_size
);
1490 /* Now read, until we've gotten it all. */
1491 while (bytes_remaining
)
1493 #ifdef TRACE_SELECTION
1494 int last
= bytes_remaining
;
1497 = XGetWindowProperty (display
, window
, property
,
1498 (long)offset
/4, (long)buffer_size
/4,
1501 actual_type_ret
, actual_format_ret
,
1502 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1504 TRACE2 ("Read %ld bytes from property %s",
1505 last
- bytes_remaining
,
1506 XGetAtomName (display
, property
));
1508 /* If this doesn't return Success at this point, it means that
1509 some clod deleted the selection while we were in the midst of
1510 reading it. Deal with that, I guess.... */
1511 if (result
!= Success
)
1513 *actual_size_ret
*= *actual_format_ret
/ 8;
1514 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1515 offset
+= *actual_size_ret
;
1517 /* This was allocated by Xlib, so use XFree. */
1518 XFree ((char *) tmp_data
);
1523 *bytes_ret
= offset
;
1526 /* Use xfree, not XFree, to free the data obtained with this function. */
1529 receive_incremental_selection (display
, window
, property
, target_type
,
1530 min_size_bytes
, data_ret
, size_bytes_ret
,
1531 type_ret
, format_ret
, size_ret
)
1535 Lisp_Object target_type
; /* for error messages only */
1536 unsigned int min_size_bytes
;
1537 unsigned char **data_ret
;
1538 int *size_bytes_ret
;
1540 unsigned long *size_ret
;
1544 struct prop_location
*wait_object
;
1545 *size_bytes_ret
= min_size_bytes
;
1546 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1548 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1550 /* At this point, we have read an INCR property.
1551 Delete the property to ack it.
1552 (But first, prepare to receive the next event in this handshake.)
1554 Now, we must loop, waiting for the sending window to put a value on
1555 that property, then reading the property, then deleting it to ack.
1556 We are done when the sender places a property of length 0.
1559 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1560 TRACE1 (" Delete property %s",
1561 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1562 XDeleteProperty (display
, window
, property
);
1563 TRACE1 (" Expect new value of property %s",
1564 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1565 wait_object
= expect_property_change (display
, window
, property
,
1572 unsigned char *tmp_data
;
1575 TRACE0 (" Wait for property change");
1576 wait_for_property_change (wait_object
);
1578 /* expect it again immediately, because x_get_window_property may
1579 .. no it won't, I don't get it.
1580 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1581 TRACE0 (" Get property value");
1582 x_get_window_property (display
, window
, property
,
1583 &tmp_data
, &tmp_size_bytes
,
1584 type_ret
, format_ret
, size_ret
, 1);
1586 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1588 if (tmp_size_bytes
== 0) /* we're done */
1590 TRACE0 ("Done reading incrementally");
1592 if (! waiting_for_other_props_on_window (display
, window
))
1593 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1594 /* Use xfree, not XFree, because x_get_window_property
1595 calls xmalloc itself. */
1596 if (tmp_data
) xfree (tmp_data
);
1601 TRACE1 (" ACK by deleting property %s",
1602 XGetAtomName (display
, property
));
1603 XDeleteProperty (display
, window
, property
);
1604 wait_object
= expect_property_change (display
, window
, property
,
1609 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1611 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1612 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1615 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1616 offset
+= tmp_size_bytes
;
1618 /* Use xfree, not XFree, because x_get_window_property
1619 calls xmalloc itself. */
1625 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1626 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1627 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1630 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1635 Lisp_Object target_type
; /* for error messages only */
1636 Atom selection_atom
; /* for error messages only */
1640 unsigned long actual_size
;
1641 unsigned char *data
= 0;
1644 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1646 TRACE0 ("Reading selection data");
1648 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1649 &actual_type
, &actual_format
, &actual_size
, 1);
1652 int there_is_a_selection_owner
;
1654 there_is_a_selection_owner
1655 = XGetSelectionOwner (display
, selection_atom
);
1658 there_is_a_selection_owner
1659 ? Fcons (build_string ("selection owner couldn't convert"),
1661 ? Fcons (target_type
,
1662 Fcons (x_atom_to_symbol (display
,
1665 : Fcons (target_type
, Qnil
))
1666 : Fcons (build_string ("no selection"),
1667 Fcons (x_atom_to_symbol (display
,
1672 if (actual_type
== dpyinfo
->Xatom_INCR
)
1674 /* That wasn't really the data, just the beginning. */
1676 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1678 /* Use xfree, not XFree, because x_get_window_property
1679 calls xmalloc itself. */
1680 xfree ((char *) data
);
1682 receive_incremental_selection (display
, window
, property
, target_type
,
1683 min_size_bytes
, &data
, &bytes
,
1684 &actual_type
, &actual_format
,
1689 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1690 XDeleteProperty (display
, window
, property
);
1694 /* It's been read. Now convert it to a lisp object in some semi-rational
1696 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1697 actual_type
, actual_format
);
1699 /* Use xfree, not XFree, because x_get_window_property
1700 calls xmalloc itself. */
1701 xfree ((char *) data
);
1705 /* These functions convert from the selection data read from the server into
1706 something that we can use from Lisp, and vice versa.
1708 Type: Format: Size: Lisp Type:
1709 ----- ------- ----- -----------
1712 ATOM 32 > 1 Vector of Symbols
1714 * 16 > 1 Vector of Integers
1715 * 32 1 if <=16 bits: Integer
1716 if > 16 bits: Cons of top16, bot16
1717 * 32 > 1 Vector of the above
1719 When converting a Lisp number to C, it is assumed to be of format 16 if
1720 it is an integer, and of format 32 if it is a cons of two integers.
1722 When converting a vector of numbers from Lisp to C, it is assumed to be
1723 of format 16 if every element in the vector is an integer, and is assumed
1724 to be of format 32 if any element is a cons of two integers.
1726 When converting an object to C, it may be of the form (SYMBOL . <data>)
1727 where SYMBOL is what we should claim that the type is. Format and
1728 representation are as above. */
1733 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1735 unsigned char *data
;
1739 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1741 if (type
== dpyinfo
->Xatom_NULL
)
1744 /* Convert any 8-bit data to a string, for compactness. */
1745 else if (format
== 8)
1747 Lisp_Object str
, lispy_type
;
1749 str
= make_unibyte_string ((char *) data
, size
);
1750 /* Indicate that this string is from foreign selection by a text
1751 property `foreign-selection' so that the caller of
1752 x-get-selection-internal (usually x-get-selection) can know
1753 that the string must be decode. */
1754 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1755 lispy_type
= QCOMPOUND_TEXT
;
1756 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1757 lispy_type
= QUTF8_STRING
;
1759 lispy_type
= QSTRING
;
1760 Fput_text_property (make_number (0), make_number (size
),
1761 Qforeign_selection
, lispy_type
, str
);
1764 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1765 a vector of symbols.
1767 else if (type
== XA_ATOM
)
1770 if (size
== sizeof (Atom
))
1771 return x_atom_to_symbol (display
, *((Atom
*) data
));
1774 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1776 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1777 Faset (v
, make_number (i
),
1778 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1783 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1784 If the number is > 16 bits, convert it to a cons of integers,
1785 16 bits in each half.
1787 else if (format
== 32 && size
== sizeof (int))
1788 return long_to_cons (((unsigned int *) data
) [0]);
1789 else if (format
== 16 && size
== sizeof (short))
1790 return make_number ((int) (((unsigned short *) data
) [0]));
1792 /* Convert any other kind of data to a vector of numbers, represented
1793 as above (as an integer, or a cons of two 16 bit integers.)
1795 else if (format
== 16)
1799 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1800 for (i
= 0; i
< size
/ 2; i
++)
1802 int j
= (int) ((unsigned short *) data
) [i
];
1803 Faset (v
, make_number (i
), make_number (j
));
1810 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1811 for (i
= 0; i
< size
/ 4; i
++)
1813 unsigned int j
= ((unsigned int *) data
) [i
];
1814 Faset (v
, make_number (i
), long_to_cons (j
));
1821 /* Use xfree, not XFree, to free the data obtained with this function. */
1824 lisp_data_to_selection_data (display
, obj
,
1825 data_ret
, type_ret
, size_ret
,
1826 format_ret
, nofree_ret
)
1829 unsigned char **data_ret
;
1831 unsigned int *size_ret
;
1835 Lisp_Object type
= Qnil
;
1836 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1840 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1844 if (CONSP (obj
) && NILP (XCDR (obj
)))
1848 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1849 { /* This is not the same as declining */
1855 else if (STRINGP (obj
))
1857 xassert (! STRING_MULTIBYTE (obj
));
1861 *size_ret
= SBYTES (obj
);
1862 *data_ret
= SDATA (obj
);
1865 else if (SYMBOLP (obj
))
1869 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1870 (*data_ret
) [sizeof (Atom
)] = 0;
1871 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1872 if (NILP (type
)) type
= QATOM
;
1874 else if (INTEGERP (obj
)
1875 && XINT (obj
) < 0xFFFF
1876 && XINT (obj
) > -0xFFFF)
1880 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1881 (*data_ret
) [sizeof (short)] = 0;
1882 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1883 if (NILP (type
)) type
= QINTEGER
;
1885 else if (INTEGERP (obj
)
1886 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1887 && (INTEGERP (XCDR (obj
))
1888 || (CONSP (XCDR (obj
))
1889 && INTEGERP (XCAR (XCDR (obj
)))))))
1893 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1894 (*data_ret
) [sizeof (long)] = 0;
1895 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1896 if (NILP (type
)) type
= QINTEGER
;
1898 else if (VECTORP (obj
))
1900 /* Lisp_Vectors may represent a set of ATOMs;
1901 a set of 16 or 32 bit INTEGERs;
1902 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1906 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1907 /* This vector is an ATOM set */
1909 if (NILP (type
)) type
= QATOM
;
1910 *size_ret
= XVECTOR (obj
)->size
;
1912 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1913 for (i
= 0; i
< *size_ret
; i
++)
1914 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1915 (*(Atom
**) data_ret
) [i
]
1916 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1918 Fsignal (Qerror
, /* Qselection_error */
1920 ("all elements of selection vector must have same type"),
1921 Fcons (obj
, Qnil
)));
1923 #if 0 /* #### MULTIPLE doesn't work yet */
1924 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1925 /* This vector is an ATOM_PAIR set */
1927 if (NILP (type
)) type
= QATOM_PAIR
;
1928 *size_ret
= XVECTOR (obj
)->size
;
1930 *data_ret
= (unsigned char *)
1931 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1932 for (i
= 0; i
< *size_ret
; i
++)
1933 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1935 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1936 if (XVECTOR (pair
)->size
!= 2)
1939 ("elements of the vector must be vectors of exactly two elements"),
1940 Fcons (pair
, Qnil
)));
1942 (*(Atom
**) data_ret
) [i
* 2]
1943 = symbol_to_x_atom (dpyinfo
, display
,
1944 XVECTOR (pair
)->contents
[0]);
1945 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1946 = symbol_to_x_atom (dpyinfo
, display
,
1947 XVECTOR (pair
)->contents
[1]);
1952 ("all elements of the vector must be of the same type"),
1953 Fcons (obj
, Qnil
)));
1958 /* This vector is an INTEGER set, or something like it */
1960 *size_ret
= XVECTOR (obj
)->size
;
1961 if (NILP (type
)) type
= QINTEGER
;
1963 for (i
= 0; i
< *size_ret
; i
++)
1964 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1966 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1967 Fsignal (Qerror
, /* Qselection_error */
1969 ("elements of selection vector must be integers or conses of integers"),
1970 Fcons (obj
, Qnil
)));
1972 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1973 for (i
= 0; i
< *size_ret
; i
++)
1974 if (*format_ret
== 32)
1975 (*((unsigned long **) data_ret
)) [i
]
1976 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1978 (*((unsigned short **) data_ret
)) [i
]
1979 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1983 Fsignal (Qerror
, /* Qselection_error */
1984 Fcons (build_string ("unrecognised selection data"),
1985 Fcons (obj
, Qnil
)));
1987 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1991 clean_local_selection_data (obj
)
1995 && INTEGERP (XCAR (obj
))
1996 && CONSP (XCDR (obj
))
1997 && INTEGERP (XCAR (XCDR (obj
)))
1998 && NILP (XCDR (XCDR (obj
))))
1999 obj
= Fcons (XCAR (obj
), XCDR (obj
));
2002 && INTEGERP (XCAR (obj
))
2003 && INTEGERP (XCDR (obj
)))
2005 if (XINT (XCAR (obj
)) == 0)
2007 if (XINT (XCAR (obj
)) == -1)
2008 return make_number (- XINT (XCDR (obj
)));
2013 int size
= XVECTOR (obj
)->size
;
2016 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
2017 copy
= Fmake_vector (make_number (size
), Qnil
);
2018 for (i
= 0; i
< size
; i
++)
2019 XVECTOR (copy
)->contents
[i
]
2020 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
2026 /* Called from XTread_socket to handle SelectionNotify events.
2027 If it's the selection we are waiting for, stop waiting
2028 by setting the car of reading_selection_reply to non-nil.
2029 We store t there if the reply is successful, lambda if not. */
2032 x_handle_selection_notify (event
)
2033 XSelectionEvent
*event
;
2035 if (event
->requestor
!= reading_selection_window
)
2037 if (event
->selection
!= reading_which_selection
)
2040 TRACE0 ("Received SelectionNotify");
2041 XSETCAR (reading_selection_reply
,
2042 (event
->property
!= 0 ? Qt
: Qlambda
));
2046 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2047 Sx_own_selection_internal
, 2, 2, 0,
2048 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2049 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2050 \(Those are literal upper-case symbol names, since that's what X expects.)
2051 VALUE is typically a string, or a cons of two markers, but may be
2052 anything that the functions on `selection-converter-alist' know about. */)
2053 (selection_name
, selection_value
)
2054 Lisp_Object selection_name
, selection_value
;
2057 CHECK_SYMBOL (selection_name
);
2058 if (NILP (selection_value
)) error ("selection-value may not be nil");
2059 x_own_selection (selection_name
, selection_value
);
2060 return selection_value
;
2064 /* Request the selection value from the owner. If we are the owner,
2065 simply return our selection value. If we are not the owner, this
2066 will block until all of the data has arrived. */
2068 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2069 Sx_get_selection_internal
, 2, 3, 0,
2070 doc
: /* Return text selected from some X window.
2071 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2072 \(Those are literal upper-case symbol names, since that's what X expects.)
2073 TYPE is the type of data desired, typically `STRING'.
2074 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2075 selections. If omitted, defaults to the time for the last event. */)
2076 (selection_symbol
, target_type
, time_stamp
)
2077 Lisp_Object selection_symbol
, target_type
, time_stamp
;
2079 Lisp_Object val
= Qnil
;
2080 struct gcpro gcpro1
, gcpro2
;
2081 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2083 CHECK_SYMBOL (selection_symbol
);
2085 #if 0 /* #### MULTIPLE doesn't work yet */
2086 if (CONSP (target_type
)
2087 && XCAR (target_type
) == QMULTIPLE
)
2089 CHECK_VECTOR (XCDR (target_type
));
2090 /* So we don't destructively modify this... */
2091 target_type
= copy_multiple_data (target_type
);
2095 CHECK_SYMBOL (target_type
);
2097 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2101 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2106 && SYMBOLP (XCAR (val
)))
2109 if (CONSP (val
) && NILP (XCDR (val
)))
2112 val
= clean_local_selection_data (val
);
2118 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2119 Sx_disown_selection_internal
, 1, 2, 0,
2120 doc
: /* If we own the selection SELECTION, disown it.
2121 Disowning it means there is no such selection. */)
2123 Lisp_Object selection
;
2127 Atom selection_atom
;
2128 struct selection_input_event event
;
2130 struct x_display_info
*dpyinfo
;
2131 struct frame
*sf
= SELECTED_FRAME ();
2134 display
= FRAME_X_DISPLAY (sf
);
2135 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2136 CHECK_SYMBOL (selection
);
2138 timestamp
= last_event_timestamp
;
2140 timestamp
= cons_to_long (time
);
2142 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2143 return Qnil
; /* Don't disown the selection when we're not the owner. */
2145 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2148 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2151 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2152 generated for a window which owns the selection when that window sets
2153 the selection owner to None. The NCD server does, the MIT Sun4 server
2154 doesn't. So we synthesize one; this means we might get two, but
2155 that's ok, because the second one won't have any effect. */
2156 SELECTION_EVENT_DISPLAY (&event
) = display
;
2157 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2158 SELECTION_EVENT_TIME (&event
) = timestamp
;
2159 x_handle_selection_clear ((struct input_event
*) &event
);
2164 /* Get rid of all the selections in buffer BUFFER.
2165 This is used when we kill a buffer. */
2168 x_disown_buffer_selections (buffer
)
2172 struct buffer
*buf
= XBUFFER (buffer
);
2174 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2176 Lisp_Object elt
, value
;
2179 if (CONSP (value
) && MARKERP (XCAR (value
))
2180 && XMARKER (XCAR (value
))->buffer
== buf
)
2181 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2185 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2187 doc
: /* Whether the current Emacs process owns the given X Selection.
2188 The arg should be the name of the selection in question, typically one of
2189 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2190 \(Those are literal upper-case symbol names, since that's what X expects.)
2191 For convenience, the symbol nil is the same as `PRIMARY',
2192 and t is the same as `SECONDARY'. */)
2194 Lisp_Object selection
;
2197 CHECK_SYMBOL (selection
);
2198 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2199 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2201 if (NILP (Fassq (selection
, Vselection_alist
)))
2206 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2208 doc
: /* Whether there is an owner for the given X Selection.
2209 The arg should be the name of the selection in question, typically one of
2210 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2211 \(Those are literal upper-case symbol names, since that's what X expects.)
2212 For convenience, the symbol nil is the same as `PRIMARY',
2213 and t is the same as `SECONDARY'. */)
2215 Lisp_Object selection
;
2220 struct frame
*sf
= SELECTED_FRAME ();
2222 /* It should be safe to call this before we have an X frame. */
2223 if (! FRAME_X_P (sf
))
2226 dpy
= FRAME_X_DISPLAY (sf
);
2227 CHECK_SYMBOL (selection
);
2228 if (!NILP (Fx_selection_owner_p (selection
)))
2230 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2231 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2232 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2236 owner
= XGetSelectionOwner (dpy
, atom
);
2238 return (owner
? Qt
: Qnil
);
2242 #ifdef CUT_BUFFER_SUPPORT
2244 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2246 initialize_cut_buffers (display
, window
)
2250 unsigned char *data
= (unsigned char *) "";
2252 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2253 PropModeAppend, data, 0)
2254 FROB (XA_CUT_BUFFER0
);
2255 FROB (XA_CUT_BUFFER1
);
2256 FROB (XA_CUT_BUFFER2
);
2257 FROB (XA_CUT_BUFFER3
);
2258 FROB (XA_CUT_BUFFER4
);
2259 FROB (XA_CUT_BUFFER5
);
2260 FROB (XA_CUT_BUFFER6
);
2261 FROB (XA_CUT_BUFFER7
);
2267 #define CHECK_CUT_BUFFER(symbol) \
2268 { CHECK_SYMBOL ((symbol)); \
2269 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2270 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2271 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2272 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2274 Fcons (build_string ("doesn't name a cut buffer"), \
2275 Fcons ((symbol), Qnil))); \
2278 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2279 Sx_get_cut_buffer_internal
, 1, 1, 0,
2280 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2286 unsigned char *data
;
2293 struct x_display_info
*dpyinfo
;
2294 struct frame
*sf
= SELECTED_FRAME ();
2297 display
= FRAME_X_DISPLAY (sf
);
2298 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2299 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2300 CHECK_CUT_BUFFER (buffer
);
2301 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2303 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2304 &type
, &format
, &size
, 0);
2305 if (!data
|| !format
)
2308 if (format
!= 8 || type
!= XA_STRING
)
2310 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2311 Fcons (x_atom_to_symbol (display
, type
),
2312 Fcons (make_number (format
), Qnil
))));
2314 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2315 /* Use xfree, not XFree, because x_get_window_property
2316 calls xmalloc itself. */
2322 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2323 Sx_store_cut_buffer_internal
, 2, 2, 0,
2324 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2326 Lisp_Object buffer
, string
;
2330 unsigned char *data
;
2332 int bytes_remaining
;
2335 struct frame
*sf
= SELECTED_FRAME ();
2338 display
= FRAME_X_DISPLAY (sf
);
2339 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2341 max_bytes
= SELECTION_QUANTUM (display
);
2342 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2343 max_bytes
= MAX_SELECTION_QUANTUM
;
2345 CHECK_CUT_BUFFER (buffer
);
2346 CHECK_STRING (string
);
2347 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2349 data
= (unsigned char *) SDATA (string
);
2350 bytes
= SBYTES (string
);
2351 bytes_remaining
= bytes
;
2353 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2355 initialize_cut_buffers (display
, window
);
2356 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2361 /* Don't mess up with an empty value. */
2362 if (!bytes_remaining
)
2363 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2364 PropModeReplace
, data
, 0);
2366 while (bytes_remaining
)
2368 int chunk
= (bytes_remaining
< max_bytes
2369 ? bytes_remaining
: max_bytes
);
2370 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2371 (bytes_remaining
== bytes
2376 bytes_remaining
-= chunk
;
2383 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2384 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2385 doc
: /* Rotate the values of the cut buffers by the given number of step.
2386 Positive means shift the values forward, negative means backward. */)
2393 struct frame
*sf
= SELECTED_FRAME ();
2396 display
= FRAME_X_DISPLAY (sf
);
2397 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2401 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2403 initialize_cut_buffers (display
, window
);
2404 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2407 props
[0] = XA_CUT_BUFFER0
;
2408 props
[1] = XA_CUT_BUFFER1
;
2409 props
[2] = XA_CUT_BUFFER2
;
2410 props
[3] = XA_CUT_BUFFER3
;
2411 props
[4] = XA_CUT_BUFFER4
;
2412 props
[5] = XA_CUT_BUFFER5
;
2413 props
[6] = XA_CUT_BUFFER6
;
2414 props
[7] = XA_CUT_BUFFER7
;
2416 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2423 /***********************************************************************
2424 Drag and drop support
2425 ***********************************************************************/
2426 /* Check that lisp values are of correct type for x_fill_property_data.
2427 That is, number, string or a cons with two numbers (low and high 16
2428 bit parts of a 32 bit number). */
2431 x_check_property_data (data
)
2437 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2439 Lisp_Object o
= XCAR (iter
);
2441 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2443 else if (CONSP (o
) &&
2444 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2451 /* Convert lisp values to a C array. Values may be a number, a string
2452 which is taken as an X atom name and converted to the atom value, or
2453 a cons containing the two 16 bit parts of a 32 bit number.
2455 DPY is the display use to look up X atoms.
2456 DATA is a Lisp list of values to be converted.
2457 RET is the C array that contains the converted values. It is assumed
2458 it is big enough to hol all values.
2459 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2460 be stored in RET. */
2463 x_fill_property_data (dpy
, data
, ret
, format
)
2470 CARD32
*d32
= (CARD32
*) ret
;
2471 CARD16
*d16
= (CARD16
*) ret
;
2472 CARD8
*d08
= (CARD8
*) ret
;
2475 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2477 Lisp_Object o
= XCAR (iter
);
2480 val
= (CARD32
) XFASTINT (o
);
2481 else if (FLOATP (o
))
2482 val
= (CARD32
) XFLOAT (o
);
2484 val
= (CARD32
) cons_to_long (o
);
2485 else if (STRINGP (o
))
2488 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2492 error ("Wrong type, must be string, number or cons");
2495 *d08
++ = (CARD8
) val
;
2496 else if (format
== 16)
2497 *d16
++ = (CARD16
) val
;
2503 /* Convert an array of C values to a Lisp list.
2504 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2505 DATA is a C array of values to be converted.
2506 TYPE is the type of the data. Only XA_ATOM is special, it converts
2507 each number in DATA to its corresponfing X atom as a symbol.
2508 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2510 SIZE is the number of elements in DATA.
2512 Also see comment for selection_data_to_lisp_data above. */
2515 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2517 unsigned char *data
;
2522 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2523 data
, size
*format
/8, type
, format
);
2526 /* Get the mouse position frame relative coordinates. */
2529 mouse_position_for_drop (f
, x
, y
)
2534 Window root
, dummy_window
;
2539 XQueryPointer (FRAME_X_DISPLAY (f
),
2540 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2542 /* The root window which contains the pointer. */
2545 /* Window pointer is on, not used */
2548 /* The position on that root window. */
2551 /* x/y in dummy_window coordinates, not used. */
2554 /* Modifier keys and pointer buttons, about which
2556 (unsigned int *) &dummy
);
2559 /* Absolute to relative. */
2560 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2561 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2566 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2567 Sx_get_atom_name
, 1, 2, 0,
2568 doc
: /* Return the X atom name for VALUE as a string.
2569 VALUE may be a number or a cons where the car is the upper 16 bits and
2570 the cdr is the lower 16 bits of a 32 bit value.
2571 Use the display for FRAME or the current frame if FRAME is not given or nil.
2573 If the value is 0 or the atom is not known, return the empty string. */)
2575 Lisp_Object value
, frame
;
2577 struct frame
*f
= check_x_frame (frame
);
2579 Lisp_Object ret
= Qnil
;
2581 Display
*dpy
= FRAME_X_DISPLAY (f
);
2584 if (INTEGERP (value
))
2585 atom
= (Atom
) XUINT (value
);
2586 else if (FLOATP (value
))
2587 atom
= (Atom
) XFLOAT (value
);
2588 else if (CONSP (value
))
2589 atom
= (Atom
) cons_to_long (value
);
2591 error ("Wrong type, value must be number or cons");
2594 count
= x_catch_errors (dpy
);
2596 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2598 if (! x_had_errors_p (dpy
))
2599 ret
= make_string (name
, strlen (name
));
2601 x_uncatch_errors (dpy
, count
);
2603 if (atom
&& name
) XFree (name
);
2604 if (NILP (ret
)) ret
= make_string ("", 0);
2611 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2612 TODO: Check if this client event really is a DND event? */
2615 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2617 XClientMessageEvent
*event
;
2618 struct x_display_info
*dpyinfo
;
2619 struct input_event
*bufp
;
2623 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2626 XSETFRAME (frame
, f
);
2628 vec
= Fmake_vector (make_number (4), Qnil
);
2629 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2630 event
->message_type
));
2631 AREF (vec
, 1) = frame
;
2632 AREF (vec
, 2) = make_number (event
->format
);
2633 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2635 event
->message_type
,
2639 mouse_position_for_drop (f
, &x
, &y
);
2640 bufp
->kind
= DRAG_N_DROP_EVENT
;
2641 bufp
->frame_or_window
= Fcons (frame
, vec
);
2642 bufp
->timestamp
= CurrentTime
;
2643 bufp
->x
= make_number (x
);
2644 bufp
->y
= make_number (y
);
2646 bufp
->modifiers
= 0;
2651 DEFUN ("x-send-client-message", Fx_send_client_event
,
2652 Sx_send_client_message
, 6, 6, 0,
2653 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2655 For DISPLAY, specify either a frame or a display name (a string).
2656 If DISPLAY is nil, that stands for the selected frame's display.
2657 DEST may be a number, in which case it is a Window id. The value 0 may
2658 be used to send to the root window of the DISPLAY.
2659 If DEST is a cons, it is converted to a 32 bit number
2660 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2661 number is then used as a window id.
2662 If DEST is a frame the event is sent to the outer window of that frame.
2663 Nil means the currently selected frame.
2664 If DEST is the string "PointerWindow" the event is sent to the window that
2665 contains the pointer. If DEST is the string "InputFocus" the event is
2666 sent to the window that has the input focus.
2667 FROM is the frame sending the event. Use nil for currently selected frame.
2668 MESSAGE-TYPE is the name of an Atom as a string.
2669 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2670 bits. VALUES is a list of numbers, cons and/or strings containing the values
2671 to send. If a value is a string, it is converted to an Atom and the value of
2672 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2673 with the high 16 bits from the car and the lower 16 bit from the cdr.
2674 If more values than fits into the event is given, the excessive values
2676 (display
, dest
, from
, message_type
, format
, values
)
2677 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2679 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2684 struct frame
*f
= check_x_frame (from
);
2688 CHECK_STRING (message_type
);
2689 CHECK_NUMBER (format
);
2690 CHECK_CONS (values
);
2692 if (x_check_property_data (values
) == -1)
2693 error ("Bad data in VALUES, must be number, cons or string");
2695 event
.xclient
.type
= ClientMessage
;
2696 event
.xclient
.format
= XFASTINT (format
);
2698 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2699 && event
.xclient
.format
!= 32)
2700 error ("FORMAT must be one of 8, 16 or 32");
2702 if (FRAMEP (dest
) || NILP (dest
))
2704 struct frame
*fdest
= check_x_frame (dest
);
2705 wdest
= FRAME_OUTER_WINDOW (fdest
);
2707 else if (STRINGP (dest
))
2709 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2710 wdest
= PointerWindow
;
2711 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2714 error ("DEST as a string must be one of PointerWindow or InputFocus");
2716 else if (INTEGERP (dest
))
2717 wdest
= (Window
) XFASTINT (dest
);
2718 else if (FLOATP (dest
))
2719 wdest
= (Window
) XFLOAT (dest
);
2720 else if (CONSP (dest
))
2722 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2723 error ("Both car and cdr for DEST must be numbers");
2725 wdest
= (Window
) cons_to_long (dest
);
2728 error ("DEST must be a frame, nil, string, number or cons");
2730 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2731 to_root
= wdest
== dpyinfo
->root_window
;
2733 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2738 event
.xclient
.message_type
2739 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2740 event
.xclient
.display
= dpyinfo
->display
;
2742 /* Some clients (metacity for example) expects sending window to be here
2743 when sending to the root window. */
2744 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2746 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2747 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2748 event
.xclient
.format
);
2750 /* If event mask is 0 the event is sent to the client that created
2751 the destination window. But if we are sending to the root window,
2752 there is no such client. Then we set the event mask to 0xffff. The
2753 event then goes to clients selecting for events on the root window. */
2754 count
= x_catch_errors (dpyinfo
->display
);
2756 int propagate
= to_root
? False
: True
;
2757 unsigned mask
= to_root
? 0xffff : 0;
2758 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2759 XFlush (dpyinfo
->display
);
2761 x_uncatch_errors (dpyinfo
->display
, count
);
2771 defsubr (&Sx_get_selection_internal
);
2772 defsubr (&Sx_own_selection_internal
);
2773 defsubr (&Sx_disown_selection_internal
);
2774 defsubr (&Sx_selection_owner_p
);
2775 defsubr (&Sx_selection_exists_p
);
2777 #ifdef CUT_BUFFER_SUPPORT
2778 defsubr (&Sx_get_cut_buffer_internal
);
2779 defsubr (&Sx_store_cut_buffer_internal
);
2780 defsubr (&Sx_rotate_cut_buffers_internal
);
2783 defsubr (&Sx_get_atom_name
);
2784 defsubr (&Sx_send_client_message
);
2786 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2787 staticpro (&reading_selection_reply
);
2788 reading_selection_window
= 0;
2789 reading_which_selection
= 0;
2791 property_change_wait_list
= 0;
2792 prop_location_identifier
= 0;
2793 property_change_reply
= Fcons (Qnil
, Qnil
);
2794 staticpro (&property_change_reply
);
2796 Vselection_alist
= Qnil
;
2797 staticpro (&Vselection_alist
);
2799 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2800 doc
: /* An alist associating X Windows selection-types with functions.
2801 These functions are called to convert the selection, with three args:
2802 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2803 a desired type to which the selection should be converted;
2804 and the local selection value (whatever was given to `x-own-selection').
2806 The function should return the value to send to the X server
2807 \(typically a string). A return value of nil
2808 means that the conversion could not be done.
2809 A return value which is the symbol `NULL'
2810 means that a side-effect was executed,
2811 and there is no meaningful selection value. */);
2812 Vselection_converter_alist
= Qnil
;
2814 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions
,
2815 doc
: /* A list of functions to be called when Emacs loses an X selection.
2816 \(This happens when some other X client makes its own selection
2817 or when a Lisp program explicitly clears the selection.)
2818 The functions are called with one argument, the selection type
2819 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2820 Vx_lost_selection_functions
= Qnil
;
2822 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions
,
2823 doc
: /* A list of functions to be called when Emacs answers a selection request.
2824 The functions are called with four arguments:
2825 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2826 - the selection-type which Emacs was asked to convert the
2827 selection into before sending (for example, `STRING' or `LENGTH');
2828 - a flag indicating success or failure for responding to the request.
2829 We might have failed (and declined the request) for any number of reasons,
2830 including being asked for a selection that we no longer own, or being asked
2831 to convert into a type that we don't know about or that is inappropriate.
2832 This hook doesn't let you change the behavior of Emacs's selection replies,
2833 it merely informs you that they have happened. */);
2834 Vx_sent_selection_functions
= Qnil
;
2836 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2837 doc
: /* Coding system for communicating with other X clients.
2838 When sending or receiving text via cut_buffer, selection, and clipboard,
2839 the text is encoded or decoded by this coding system.
2840 The default value is `compound-text-with-extensions'. */);
2841 Vselection_coding_system
= intern ("compound-text-with-extensions");
2843 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2844 doc
: /* Coding system for the next communication with other X clients.
2845 Usually, `selection-coding-system' is used for communicating with
2846 other X clients. But, if this variable is set, it is used for the
2847 next communication only. After the communication, this variable is
2849 Vnext_selection_coding_system
= Qnil
;
2851 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2852 doc
: /* Number of milliseconds to wait for a selection reply.
2853 If the selection owner doesn't reply in this time, we give up.
2854 A value of 0 means wait as long as necessary. This is initialized from the
2855 \"*selectionTimeout\" resource. */);
2856 x_selection_timeout
= 0;
2858 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2859 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2860 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2861 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2862 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2863 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2864 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2865 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2866 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2867 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2868 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2869 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2870 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2871 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2872 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2873 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2874 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2875 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2876 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2877 staticpro (&Qcompound_text_with_extensions
);
2879 #ifdef CUT_BUFFER_SUPPORT
2880 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2881 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2882 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2883 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2884 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2885 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2886 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2887 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2890 Qforeign_selection
= intern ("foreign-selection");
2891 staticpro (&Qforeign_selection
);
2894 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2895 (do not change this comment) */