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
;
397 Time time
= last_event_timestamp
;
399 struct x_display_info
*dpyinfo
;
402 if (! FRAME_X_P (sf
))
405 selecting_window
= FRAME_X_WINDOW (sf
);
406 display
= FRAME_X_DISPLAY (sf
);
407 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
409 CHECK_SYMBOL (selection_name
);
410 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
413 count
= x_catch_errors (display
);
414 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
415 x_check_errors (display
, "Can't set selection: %s");
416 x_uncatch_errors (display
, count
);
419 /* Now update the local cache */
421 Lisp_Object selection_time
;
422 Lisp_Object selection_data
;
423 Lisp_Object prev_value
;
425 selection_time
= long_to_cons ((unsigned long) time
);
426 selection_data
= Fcons (selection_name
,
427 Fcons (selection_value
,
428 Fcons (selection_time
,
429 Fcons (selected_frame
, Qnil
))));
430 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
432 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
434 /* If we already owned the selection, remove the old selection data.
435 Perhaps we should destructively modify it instead.
436 Don't use Fdelq as that may QUIT. */
437 if (!NILP (prev_value
))
439 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
440 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
441 if (EQ (prev_value
, Fcar (XCDR (rest
))))
443 XSETCDR (rest
, Fcdr (XCDR (rest
)));
450 /* Given a selection-name and desired type, look up our local copy of
451 the selection value and convert it to the type.
452 The value is nil or a string.
453 This function is used both for remote requests (LOCAL_REQUEST is zero)
454 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
456 This calls random Lisp code, and may signal or gc. */
459 x_get_local_selection (selection_symbol
, target_type
, local_request
)
460 Lisp_Object selection_symbol
, target_type
;
463 Lisp_Object local_value
;
464 Lisp_Object handler_fn
, value
, type
, check
;
467 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
469 if (NILP (local_value
)) return Qnil
;
471 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
472 if (EQ (target_type
, QTIMESTAMP
))
475 value
= XCAR (XCDR (XCDR (local_value
)));
478 else if (EQ (target_type
, QDELETE
))
481 Fx_disown_selection_internal
483 XCAR (XCDR (XCDR (local_value
))));
488 #if 0 /* #### MULTIPLE doesn't work yet */
489 else if (CONSP (target_type
)
490 && XCAR (target_type
) == QMULTIPLE
)
495 pairs
= XCDR (target_type
);
496 size
= XVECTOR (pairs
)->size
;
497 /* If the target is MULTIPLE, then target_type looks like
498 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
499 We modify the second element of each pair in the vector and
500 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
502 for (i
= 0; i
< size
; i
++)
505 pair
= XVECTOR (pairs
)->contents
[i
];
506 XVECTOR (pair
)->contents
[1]
507 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
508 XVECTOR (pair
)->contents
[1],
516 /* Don't allow a quit within the converter.
517 When the user types C-g, he would be surprised
518 if by luck it came during a converter. */
519 count
= SPECPDL_INDEX ();
520 specbind (Qinhibit_quit
, Qt
);
522 CHECK_SYMBOL (target_type
);
523 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
524 /* gcpro is not needed here since nothing but HANDLER_FN
525 is live, and that ought to be a symbol. */
527 if (!NILP (handler_fn
))
528 value
= call3 (handler_fn
,
529 selection_symbol
, (local_request
? Qnil
: target_type
),
530 XCAR (XCDR (local_value
)));
533 unbind_to (count
, Qnil
);
536 /* Make sure this value is of a type that we could transmit
537 to another X client. */
541 && SYMBOLP (XCAR (value
)))
543 check
= XCDR (value
);
551 /* Check for a value that cons_to_long could handle. */
552 else if (CONSP (check
)
553 && INTEGERP (XCAR (check
))
554 && (INTEGERP (XCDR (check
))
556 (CONSP (XCDR (check
))
557 && INTEGERP (XCAR (XCDR (check
)))
558 && NILP (XCDR (XCDR (check
))))))
563 Fcons (build_string ("invalid data returned by selection-conversion function"),
564 Fcons (handler_fn
, Fcons (value
, Qnil
))));
567 /* Subroutines of x_reply_selection_request. */
569 /* Send a SelectionNotify event to the requestor with property=None,
570 meaning we were unable to do what they wanted. */
573 x_decline_selection_request (event
)
574 struct input_event
*event
;
576 XSelectionEvent reply
;
579 reply
.type
= SelectionNotify
;
580 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
581 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
582 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
583 reply
.time
= SELECTION_EVENT_TIME (event
);
584 reply
.target
= SELECTION_EVENT_TARGET (event
);
585 reply
.property
= None
;
587 /* The reason for the error may be that the receiver has
588 died in the meantime. Handle that case. */
590 count
= x_catch_errors (reply
.display
);
591 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
592 XFlush (reply
.display
);
593 x_uncatch_errors (reply
.display
, count
);
597 /* This is the selection request currently being processed.
598 It is set to zero when the request is fully processed. */
599 static struct input_event
*x_selection_current_request
;
601 /* Display info in x_selection_request. */
603 static struct x_display_info
*selection_request_dpyinfo
;
605 /* Used as an unwind-protect clause so that, if a selection-converter signals
606 an error, we tell the requester that we were unable to do what they wanted
607 before we throw to top-level or go into the debugger or whatever. */
610 x_selection_request_lisp_error (ignore
)
613 if (x_selection_current_request
!= 0
614 && selection_request_dpyinfo
->display
)
615 x_decline_selection_request (x_selection_current_request
);
620 /* This stuff is so that INCR selections are reentrant (that is, so we can
621 be servicing multiple INCR selection requests simultaneously.) I haven't
622 actually tested that yet. */
624 /* Keep a list of the property changes that are awaited. */
634 struct prop_location
*next
;
637 static struct prop_location
*expect_property_change ();
638 static void wait_for_property_change ();
639 static void unexpect_property_change ();
640 static int waiting_for_other_props_on_window ();
642 static int prop_location_identifier
;
644 static Lisp_Object property_change_reply
;
646 static struct prop_location
*property_change_reply_object
;
648 static struct prop_location
*property_change_wait_list
;
651 queue_selection_requests_unwind (tem
)
654 x_stop_queuing_selection_requests ();
658 /* Return some frame whose display info is DPYINFO.
659 Return nil if there is none. */
662 some_frame_on_display (dpyinfo
)
663 struct x_display_info
*dpyinfo
;
665 Lisp_Object list
, frame
;
667 FOR_EACH_FRAME (list
, frame
)
669 if (FRAME_X_P (XFRAME (frame
))
670 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
677 /* Send the reply to a selection request event EVENT.
678 TYPE is the type of selection data requested.
679 DATA and SIZE describe the data to send, already converted.
680 FORMAT is the unit-size (in bits) of the data to be transmitted. */
683 x_reply_selection_request (event
, format
, data
, size
, type
)
684 struct input_event
*event
;
689 XSelectionEvent reply
;
690 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
691 Window window
= SELECTION_EVENT_REQUESTOR (event
);
693 int format_bytes
= format
/8;
694 int max_bytes
= SELECTION_QUANTUM (display
);
695 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
698 if (max_bytes
> MAX_SELECTION_QUANTUM
)
699 max_bytes
= MAX_SELECTION_QUANTUM
;
701 reply
.type
= SelectionNotify
;
702 reply
.display
= display
;
703 reply
.requestor
= window
;
704 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
705 reply
.time
= SELECTION_EVENT_TIME (event
);
706 reply
.target
= SELECTION_EVENT_TARGET (event
);
707 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
708 if (reply
.property
== None
)
709 reply
.property
= reply
.target
;
711 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
713 count
= x_catch_errors (display
);
715 #ifdef TRACE_SELECTION
718 char *sel
= XGetAtomName (display
, reply
.selection
);
719 char *tgt
= XGetAtomName (display
, reply
.target
);
720 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++cnt
);
721 if (sel
) XFree (sel
);
722 if (tgt
) XFree (tgt
);
724 #endif /* TRACE_SELECTION */
726 /* Store the data on the requested property.
727 If the selection is large, only store the first N bytes of it.
729 bytes_remaining
= size
* format_bytes
;
730 if (bytes_remaining
<= max_bytes
)
732 /* Send all the data at once, with minimal handshaking. */
733 TRACE1 ("Sending all %d bytes", bytes_remaining
);
734 XChangeProperty (display
, window
, reply
.property
, type
, format
,
735 PropModeReplace
, data
, size
);
736 /* At this point, the selection was successfully stored; ack it. */
737 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
741 /* Send an INCR selection. */
742 struct prop_location
*wait_object
;
746 frame
= some_frame_on_display (dpyinfo
);
748 /* If the display no longer has frames, we can't expect
749 to get many more selection requests from it, so don't
750 bother trying to queue them. */
753 x_start_queuing_selection_requests ();
755 record_unwind_protect (queue_selection_requests_unwind
,
759 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
760 error ("Attempt to transfer an INCR to ourself!");
762 TRACE2 ("Start sending %d bytes incrementally (%s)",
763 bytes_remaining
, XGetAtomName (display
, reply
.property
));
764 wait_object
= expect_property_change (display
, window
, reply
.property
,
767 TRACE1 ("Set %s to number of bytes to send",
768 XGetAtomName (display
, reply
.property
));
769 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
771 (unsigned char *) &bytes_remaining
, 1);
772 XSelectInput (display
, window
, PropertyChangeMask
);
774 /* Tell 'em the INCR data is there... */
775 TRACE0 ("Send SelectionNotify event");
776 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
779 had_errors
= x_had_errors_p (display
);
782 /* First, wait for the requester to ack by deleting the property.
783 This can run random lisp code (process handlers) or signal. */
786 TRACE1 ("Waiting for ACK (deletion of %s)",
787 XGetAtomName (display
, reply
.property
));
788 wait_for_property_change (wait_object
);
791 unexpect_property_change (wait_object
);
794 while (bytes_remaining
)
796 int i
= ((bytes_remaining
< max_bytes
)
803 = expect_property_change (display
, window
, reply
.property
,
806 TRACE1 ("Sending increment of %d bytes", i
);
807 TRACE1 ("Set %s to increment data",
808 XGetAtomName (display
, reply
.property
));
810 /* Append the next chunk of data to the property. */
811 XChangeProperty (display
, window
, reply
.property
, type
, format
,
812 PropModeAppend
, data
, i
/ format_bytes
);
813 bytes_remaining
-= i
;
816 had_errors
= x_had_errors_p (display
);
822 /* Now wait for the requester to ack this chunk by deleting the
823 property. This can run random lisp code or signal. */
824 TRACE1 ("Waiting for increment ACK (deletion of %s)",
825 XGetAtomName (display
, reply
.property
));
826 wait_for_property_change (wait_object
);
829 /* Now write a zero-length chunk to the property to tell the
830 requester that we're done. */
832 if (! waiting_for_other_props_on_window (display
, window
))
833 XSelectInput (display
, window
, 0L);
835 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
836 XGetAtomName (display
, reply
.property
));
837 XChangeProperty (display
, window
, reply
.property
, type
, format
,
838 PropModeReplace
, data
, 0);
839 TRACE0 ("Done sending incrementally");
842 /* rms, 2003-01-03: I think I have fixed this bug. */
843 /* The window we're communicating with may have been deleted
844 in the meantime (that's a real situation from a bug report).
845 In this case, there may be events in the event queue still
846 refering to the deleted window, and we'll get a BadWindow error
847 in XTread_socket when processing the events. I don't have
848 an idea how to fix that. gerd, 2001-01-98. */
849 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
850 delivered before uncatch errors. */
851 XSync (display
, False
);
854 /* GTK queues events in addition to the queue in Xlib. So we
855 UNBLOCK to enter the event loop and get possible errors delivered,
856 and then BLOCK again because x_uncatch_errors requires it. */
858 x_uncatch_errors (display
, count
);
862 /* Handle a SelectionRequest event EVENT.
863 This is called from keyboard.c when such an event is found in the queue. */
866 x_handle_selection_request (event
)
867 struct input_event
*event
;
869 struct gcpro gcpro1
, gcpro2
, gcpro3
;
870 Lisp_Object local_selection_data
;
871 Lisp_Object selection_symbol
;
872 Lisp_Object target_symbol
;
873 Lisp_Object converted_selection
;
874 Time local_selection_time
;
875 Lisp_Object successful_p
;
877 struct x_display_info
*dpyinfo
878 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
880 TRACE0 ("x_handle_selection_request");
882 local_selection_data
= Qnil
;
883 target_symbol
= Qnil
;
884 converted_selection
= Qnil
;
887 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
889 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
890 SELECTION_EVENT_SELECTION (event
));
892 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
894 if (NILP (local_selection_data
))
896 /* Someone asked for the selection, but we don't have it any more.
898 x_decline_selection_request (event
);
902 local_selection_time
= (Time
)
903 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
905 if (SELECTION_EVENT_TIME (event
) != CurrentTime
906 && local_selection_time
> SELECTION_EVENT_TIME (event
))
908 /* Someone asked for the selection, and we have one, but not the one
911 x_decline_selection_request (event
);
915 x_selection_current_request
= event
;
916 count
= SPECPDL_INDEX ();
917 selection_request_dpyinfo
= dpyinfo
;
918 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
920 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
921 SELECTION_EVENT_TARGET (event
));
923 #if 0 /* #### MULTIPLE doesn't work yet */
924 if (EQ (target_symbol
, QMULTIPLE
))
925 target_symbol
= fetch_multiple_target (event
);
928 /* Convert lisp objects back into binary data */
931 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
933 if (! NILP (converted_selection
))
941 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
943 &data
, &type
, &size
, &format
, &nofree
);
945 x_reply_selection_request (event
, format
, data
, size
, type
);
948 /* Indicate we have successfully processed this event. */
949 x_selection_current_request
= 0;
951 /* Use xfree, not XFree, because lisp_data_to_selection_data
952 calls xmalloc itself. */
956 unbind_to (count
, Qnil
);
960 /* Let random lisp code notice that the selection has been asked for. */
963 rest
= Vx_sent_selection_functions
;
964 if (!EQ (rest
, Qunbound
))
965 for (; CONSP (rest
); rest
= Fcdr (rest
))
966 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
972 /* Handle a SelectionClear event EVENT, which indicates that some
973 client cleared out our previously asserted selection.
974 This is called from keyboard.c when such an event is found in the queue. */
977 x_handle_selection_clear (event
)
978 struct input_event
*event
;
980 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
981 Atom selection
= SELECTION_EVENT_SELECTION (event
);
982 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
984 Lisp_Object selection_symbol
, local_selection_data
;
985 Time local_selection_time
;
986 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
987 struct x_display_info
*t_dpyinfo
;
989 TRACE0 ("x_handle_selection_clear");
991 /* If the new selection owner is also Emacs,
992 don't clear the new selection. */
994 /* Check each display on the same terminal,
995 to see if this Emacs job now owns the selection
996 through that display. */
997 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
998 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
1001 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
1002 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
1010 selection_symbol
= x_atom_to_symbol (display
, selection
);
1012 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
1014 /* Well, we already believe that we don't own it, so that's just fine. */
1015 if (NILP (local_selection_data
)) return;
1017 local_selection_time
= (Time
)
1018 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
1020 /* This SelectionClear is for a selection that we no longer own, so we can
1021 disregard it. (That is, we have reasserted the selection since this
1022 request was generated.) */
1024 if (changed_owner_time
!= CurrentTime
1025 && local_selection_time
> changed_owner_time
)
1028 /* Otherwise, we're really honest and truly being told to drop it.
1029 Don't use Fdelq as that may QUIT;. */
1031 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
1032 Vselection_alist
= Fcdr (Vselection_alist
);
1036 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1037 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
1039 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1044 /* Let random lisp code notice that the selection has been stolen. */
1048 rest
= Vx_lost_selection_functions
;
1049 if (!EQ (rest
, Qunbound
))
1051 for (; CONSP (rest
); rest
= Fcdr (rest
))
1052 call1 (Fcar (rest
), selection_symbol
);
1053 prepare_menu_bars ();
1054 redisplay_preserve_echo_area (20);
1060 x_handle_selection_event (event
)
1061 struct input_event
*event
;
1063 TRACE0 ("x_handle_selection_event");
1065 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1067 if (x_queue_selection_requests
)
1068 x_queue_event (event
);
1070 x_handle_selection_request (event
);
1073 x_handle_selection_clear (event
);
1077 /* Clear all selections that were made from frame F.
1078 We do this when about to delete a frame. */
1081 x_clear_frame_selections (f
)
1087 XSETFRAME (frame
, f
);
1089 /* Otherwise, we're really honest and truly being told to drop it.
1090 Don't use Fdelq as that may QUIT;. */
1092 /* Delete elements from the beginning of Vselection_alist. */
1093 while (!NILP (Vselection_alist
)
1094 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1096 /* Let random Lisp code notice that the selection has been stolen. */
1097 Lisp_Object hooks
, selection_symbol
;
1099 hooks
= Vx_lost_selection_functions
;
1100 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1102 if (!EQ (hooks
, Qunbound
))
1104 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1105 call1 (Fcar (hooks
), selection_symbol
);
1106 #if 0 /* This can crash when deleting a frame
1107 from x_connection_closed. Anyway, it seems unnecessary;
1108 something else should cause a redisplay. */
1109 redisplay_preserve_echo_area (21);
1113 Vselection_alist
= Fcdr (Vselection_alist
);
1116 /* Delete elements after the beginning of Vselection_alist. */
1117 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1118 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1120 /* Let random Lisp code notice that the selection has been stolen. */
1121 Lisp_Object hooks
, selection_symbol
;
1123 hooks
= Vx_lost_selection_functions
;
1124 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1126 if (!EQ (hooks
, Qunbound
))
1128 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1129 call1 (Fcar (hooks
), selection_symbol
);
1130 #if 0 /* See above */
1131 redisplay_preserve_echo_area (22);
1134 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1139 /* Nonzero if any properties for DISPLAY and WINDOW
1140 are on the list of what we are waiting for. */
1143 waiting_for_other_props_on_window (display
, window
)
1147 struct prop_location
*rest
= property_change_wait_list
;
1149 if (rest
->display
== display
&& rest
->window
== window
)
1156 /* Add an entry to the list of property changes we are waiting for.
1157 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1158 The return value is a number that uniquely identifies
1159 this awaited property change. */
1161 static struct prop_location
*
1162 expect_property_change (display
, window
, property
, state
)
1168 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1169 pl
->identifier
= ++prop_location_identifier
;
1170 pl
->display
= display
;
1171 pl
->window
= window
;
1172 pl
->property
= property
;
1173 pl
->desired_state
= state
;
1174 pl
->next
= property_change_wait_list
;
1176 property_change_wait_list
= pl
;
1180 /* Delete an entry from the list of property changes we are waiting for.
1181 IDENTIFIER is the number that uniquely identifies the entry. */
1184 unexpect_property_change (location
)
1185 struct prop_location
*location
;
1187 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1190 if (rest
== location
)
1193 prev
->next
= rest
->next
;
1195 property_change_wait_list
= rest
->next
;
1204 /* Remove the property change expectation element for IDENTIFIER. */
1207 wait_for_property_change_unwind (loc
)
1210 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1212 unexpect_property_change (location
);
1213 if (location
== property_change_reply_object
)
1214 property_change_reply_object
= 0;
1218 /* Actually wait for a property change.
1219 IDENTIFIER should be the value that expect_property_change returned. */
1222 wait_for_property_change (location
)
1223 struct prop_location
*location
;
1226 int count
= SPECPDL_INDEX ();
1228 if (property_change_reply_object
)
1231 /* Make sure to do unexpect_property_change if we quit or err. */
1232 record_unwind_protect (wait_for_property_change_unwind
,
1233 make_save_value (location
, 0));
1235 XSETCAR (property_change_reply
, Qnil
);
1236 property_change_reply_object
= location
;
1238 /* If the event we are waiting for arrives beyond here, it will set
1239 property_change_reply, because property_change_reply_object says so. */
1240 if (! location
->arrived
)
1242 secs
= x_selection_timeout
/ 1000;
1243 usecs
= (x_selection_timeout
% 1000) * 1000;
1244 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1245 wait_reading_process_output (secs
, usecs
, 0, 0,
1246 property_change_reply
, NULL
, 0);
1248 if (NILP (XCAR (property_change_reply
)))
1250 TRACE0 (" Timed out");
1251 error ("Timed out waiting for property-notify event");
1255 unbind_to (count
, Qnil
);
1258 /* Called from XTread_socket in response to a PropertyNotify event. */
1261 x_handle_property_notify (event
)
1262 XPropertyEvent
*event
;
1264 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1269 && rest
->property
== event
->atom
1270 && rest
->window
== event
->window
1271 && rest
->display
== event
->display
1272 && rest
->desired_state
== event
->state
)
1274 TRACE2 ("Expected %s of property %s",
1275 (event
->state
== PropertyDelete
? "deletion" : "change"),
1276 XGetAtomName (event
->display
, event
->atom
));
1280 /* If this is the one wait_for_property_change is waiting for,
1281 tell it to wake up. */
1282 if (rest
== property_change_reply_object
)
1283 XSETCAR (property_change_reply
, Qt
);
1295 #if 0 /* #### MULTIPLE doesn't work yet */
1298 fetch_multiple_target (event
)
1299 XSelectionRequestEvent
*event
;
1301 Display
*display
= event
->display
;
1302 Window window
= event
->requestor
;
1303 Atom target
= event
->target
;
1304 Atom selection_atom
= event
->selection
;
1309 x_get_window_property_as_lisp_data (display
, window
, target
,
1310 QMULTIPLE
, selection_atom
));
1314 copy_multiple_data (obj
)
1321 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1324 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1325 for (i
= 0; i
< size
; i
++)
1327 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1328 CHECK_VECTOR (vec2
);
1329 if (XVECTOR (vec2
)->size
!= 2)
1330 /* ??? Confusing error message */
1331 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1332 Fcons (vec2
, Qnil
)));
1333 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1334 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1335 = XVECTOR (vec2
)->contents
[0];
1336 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1337 = XVECTOR (vec2
)->contents
[1];
1345 /* Variables for communication with x_handle_selection_notify. */
1346 static Atom reading_which_selection
;
1347 static Lisp_Object reading_selection_reply
;
1348 static Window reading_selection_window
;
1350 /* Do protocol to read selection-data from the server.
1351 Converts this to Lisp data and returns it. */
1354 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1355 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1357 struct frame
*sf
= SELECTED_FRAME ();
1358 Window requestor_window
;
1360 struct x_display_info
*dpyinfo
;
1361 Time requestor_time
= last_event_timestamp
;
1362 Atom target_property
;
1363 Atom selection_atom
;
1369 if (! FRAME_X_P (sf
))
1372 requestor_window
= FRAME_X_WINDOW (sf
);
1373 display
= FRAME_X_DISPLAY (sf
);
1374 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1375 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1376 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1378 if (CONSP (target_type
))
1379 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1381 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1383 if (! NILP (time_stamp
))
1385 if (CONSP (time_stamp
))
1386 requestor_time
= (Time
) cons_to_long (time_stamp
);
1387 else if (INTEGERP (time_stamp
))
1388 requestor_time
= (Time
) XUINT (time_stamp
);
1389 else if (FLOATP (time_stamp
))
1390 requestor_time
= (Time
) XFLOAT (time_stamp
);
1392 error ("TIME_STAMP must be cons or number");
1397 count
= x_catch_errors (display
);
1399 TRACE2 ("Get selection %s, type %s",
1400 XGetAtomName (display
, type_atom
),
1401 XGetAtomName (display
, target_property
));
1403 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1404 requestor_window
, requestor_time
);
1407 /* Prepare to block until the reply has been read. */
1408 reading_selection_window
= requestor_window
;
1409 reading_which_selection
= selection_atom
;
1410 XSETCAR (reading_selection_reply
, Qnil
);
1412 frame
= some_frame_on_display (dpyinfo
);
1414 /* If the display no longer has frames, we can't expect
1415 to get many more selection requests from it, so don't
1416 bother trying to queue them. */
1419 x_start_queuing_selection_requests ();
1421 record_unwind_protect (queue_selection_requests_unwind
,
1426 /* This allows quits. Also, don't wait forever. */
1427 secs
= x_selection_timeout
/ 1000;
1428 usecs
= (x_selection_timeout
% 1000) * 1000;
1429 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1430 wait_reading_process_output (secs
, usecs
, 0, 0,
1431 reading_selection_reply
, NULL
, 0);
1432 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1435 x_check_errors (display
, "Cannot get selection: %s");
1436 x_uncatch_errors (display
, count
);
1439 if (NILP (XCAR (reading_selection_reply
)))
1440 error ("Timed out waiting for reply from selection owner");
1441 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1442 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1444 /* Otherwise, the selection is waiting for us on the requested property. */
1446 x_get_window_property_as_lisp_data (display
, requestor_window
,
1447 target_property
, target_type
,
1451 /* Subroutines of x_get_window_property_as_lisp_data */
1453 /* Use xfree, not XFree, to free the data obtained with this function. */
1456 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1457 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1462 unsigned char **data_ret
;
1464 Atom
*actual_type_ret
;
1465 int *actual_format_ret
;
1466 unsigned long *actual_size_ret
;
1470 unsigned long bytes_remaining
;
1472 unsigned char *tmp_data
= 0;
1474 int buffer_size
= SELECTION_QUANTUM (display
);
1476 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1477 buffer_size
= MAX_SELECTION_QUANTUM
;
1481 /* First probe the thing to find out how big it is. */
1482 result
= XGetWindowProperty (display
, window
, property
,
1483 0L, 0L, False
, AnyPropertyType
,
1484 actual_type_ret
, actual_format_ret
,
1486 &bytes_remaining
, &tmp_data
);
1487 if (result
!= Success
)
1495 /* This was allocated by Xlib, so use XFree. */
1496 XFree ((char *) tmp_data
);
1498 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1504 total_size
= bytes_remaining
+ 1;
1505 *data_ret
= (unsigned char *) xmalloc (total_size
);
1507 /* Now read, until we've gotten it all. */
1508 while (bytes_remaining
)
1510 #ifdef TRACE_SELECTION
1511 int last
= bytes_remaining
;
1514 = XGetWindowProperty (display
, window
, property
,
1515 (long)offset
/4, (long)buffer_size
/4,
1518 actual_type_ret
, actual_format_ret
,
1519 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1521 TRACE2 ("Read %ld bytes from property %s",
1522 last
- bytes_remaining
,
1523 XGetAtomName (display
, property
));
1525 /* If this doesn't return Success at this point, it means that
1526 some clod deleted the selection while we were in the midst of
1527 reading it. Deal with that, I guess.... */
1528 if (result
!= Success
)
1530 *actual_size_ret
*= *actual_format_ret
/ 8;
1531 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1532 offset
+= *actual_size_ret
;
1534 /* This was allocated by Xlib, so use XFree. */
1535 XFree ((char *) tmp_data
);
1540 *bytes_ret
= offset
;
1543 /* Use xfree, not XFree, to free the data obtained with this function. */
1546 receive_incremental_selection (display
, window
, property
, target_type
,
1547 min_size_bytes
, data_ret
, size_bytes_ret
,
1548 type_ret
, format_ret
, size_ret
)
1552 Lisp_Object target_type
; /* for error messages only */
1553 unsigned int min_size_bytes
;
1554 unsigned char **data_ret
;
1555 int *size_bytes_ret
;
1557 unsigned long *size_ret
;
1561 struct prop_location
*wait_object
;
1562 *size_bytes_ret
= min_size_bytes
;
1563 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1565 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1567 /* At this point, we have read an INCR property.
1568 Delete the property to ack it.
1569 (But first, prepare to receive the next event in this handshake.)
1571 Now, we must loop, waiting for the sending window to put a value on
1572 that property, then reading the property, then deleting it to ack.
1573 We are done when the sender places a property of length 0.
1576 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1577 TRACE1 (" Delete property %s",
1578 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1579 XDeleteProperty (display
, window
, property
);
1580 TRACE1 (" Expect new value of property %s",
1581 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1582 wait_object
= expect_property_change (display
, window
, property
,
1589 unsigned char *tmp_data
;
1592 TRACE0 (" Wait for property change");
1593 wait_for_property_change (wait_object
);
1595 /* expect it again immediately, because x_get_window_property may
1596 .. no it won't, I don't get it.
1597 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1598 TRACE0 (" Get property value");
1599 x_get_window_property (display
, window
, property
,
1600 &tmp_data
, &tmp_size_bytes
,
1601 type_ret
, format_ret
, size_ret
, 1);
1603 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1605 if (tmp_size_bytes
== 0) /* we're done */
1607 TRACE0 ("Done reading incrementally");
1609 if (! waiting_for_other_props_on_window (display
, window
))
1610 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1611 /* Use xfree, not XFree, because x_get_window_property
1612 calls xmalloc itself. */
1613 if (tmp_data
) xfree (tmp_data
);
1618 TRACE1 (" ACK by deleting property %s",
1619 XGetAtomName (display
, property
));
1620 XDeleteProperty (display
, window
, property
);
1621 wait_object
= expect_property_change (display
, window
, property
,
1626 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1628 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1629 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1632 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1633 offset
+= tmp_size_bytes
;
1635 /* Use xfree, not XFree, because x_get_window_property
1636 calls xmalloc itself. */
1642 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1643 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1644 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1647 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1652 Lisp_Object target_type
; /* for error messages only */
1653 Atom selection_atom
; /* for error messages only */
1657 unsigned long actual_size
;
1658 unsigned char *data
= 0;
1661 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1663 TRACE0 ("Reading selection data");
1665 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1666 &actual_type
, &actual_format
, &actual_size
, 1);
1669 int there_is_a_selection_owner
;
1671 there_is_a_selection_owner
1672 = XGetSelectionOwner (display
, selection_atom
);
1675 there_is_a_selection_owner
1676 ? Fcons (build_string ("selection owner couldn't convert"),
1678 ? Fcons (target_type
,
1679 Fcons (x_atom_to_symbol (display
,
1682 : Fcons (target_type
, Qnil
))
1683 : Fcons (build_string ("no selection"),
1684 Fcons (x_atom_to_symbol (display
,
1689 if (actual_type
== dpyinfo
->Xatom_INCR
)
1691 /* That wasn't really the data, just the beginning. */
1693 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1695 /* Use xfree, not XFree, because x_get_window_property
1696 calls xmalloc itself. */
1697 xfree ((char *) data
);
1699 receive_incremental_selection (display
, window
, property
, target_type
,
1700 min_size_bytes
, &data
, &bytes
,
1701 &actual_type
, &actual_format
,
1706 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1707 XDeleteProperty (display
, window
, property
);
1711 /* It's been read. Now convert it to a lisp object in some semi-rational
1713 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1714 actual_type
, actual_format
);
1716 /* Use xfree, not XFree, because x_get_window_property
1717 calls xmalloc itself. */
1718 xfree ((char *) data
);
1722 /* These functions convert from the selection data read from the server into
1723 something that we can use from Lisp, and vice versa.
1725 Type: Format: Size: Lisp Type:
1726 ----- ------- ----- -----------
1729 ATOM 32 > 1 Vector of Symbols
1731 * 16 > 1 Vector of Integers
1732 * 32 1 if <=16 bits: Integer
1733 if > 16 bits: Cons of top16, bot16
1734 * 32 > 1 Vector of the above
1736 When converting a Lisp number to C, it is assumed to be of format 16 if
1737 it is an integer, and of format 32 if it is a cons of two integers.
1739 When converting a vector of numbers from Lisp to C, it is assumed to be
1740 of format 16 if every element in the vector is an integer, and is assumed
1741 to be of format 32 if any element is a cons of two integers.
1743 When converting an object to C, it may be of the form (SYMBOL . <data>)
1744 where SYMBOL is what we should claim that the type is. Format and
1745 representation are as above. */
1750 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1752 unsigned char *data
;
1756 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1758 if (type
== dpyinfo
->Xatom_NULL
)
1761 /* Convert any 8-bit data to a string, for compactness. */
1762 else if (format
== 8)
1764 Lisp_Object str
, lispy_type
;
1766 str
= make_unibyte_string ((char *) data
, size
);
1767 /* Indicate that this string is from foreign selection by a text
1768 property `foreign-selection' so that the caller of
1769 x-get-selection-internal (usually x-get-selection) can know
1770 that the string must be decode. */
1771 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1772 lispy_type
= QCOMPOUND_TEXT
;
1773 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1774 lispy_type
= QUTF8_STRING
;
1776 lispy_type
= QSTRING
;
1777 Fput_text_property (make_number (0), make_number (size
),
1778 Qforeign_selection
, lispy_type
, str
);
1781 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1782 a vector of symbols.
1784 else if (type
== XA_ATOM
)
1787 if (size
== sizeof (Atom
))
1788 return x_atom_to_symbol (display
, *((Atom
*) data
));
1791 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1793 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1794 Faset (v
, make_number (i
),
1795 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1800 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1801 If the number is > 16 bits, convert it to a cons of integers,
1802 16 bits in each half.
1804 else if (format
== 32 && size
== sizeof (int))
1805 return long_to_cons (((unsigned int *) data
) [0]);
1806 else if (format
== 16 && size
== sizeof (short))
1807 return make_number ((int) (((unsigned short *) data
) [0]));
1809 /* Convert any other kind of data to a vector of numbers, represented
1810 as above (as an integer, or a cons of two 16 bit integers.)
1812 else if (format
== 16)
1816 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1817 for (i
= 0; i
< size
/ 2; i
++)
1819 int j
= (int) ((unsigned short *) data
) [i
];
1820 Faset (v
, make_number (i
), make_number (j
));
1827 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1828 for (i
= 0; i
< size
/ 4; i
++)
1830 unsigned int j
= ((unsigned int *) data
) [i
];
1831 Faset (v
, make_number (i
), long_to_cons (j
));
1838 /* Use xfree, not XFree, to free the data obtained with this function. */
1841 lisp_data_to_selection_data (display
, obj
,
1842 data_ret
, type_ret
, size_ret
,
1843 format_ret
, nofree_ret
)
1846 unsigned char **data_ret
;
1848 unsigned int *size_ret
;
1852 Lisp_Object type
= Qnil
;
1853 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1857 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1861 if (CONSP (obj
) && NILP (XCDR (obj
)))
1865 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1866 { /* This is not the same as declining */
1872 else if (STRINGP (obj
))
1874 xassert (! STRING_MULTIBYTE (obj
));
1878 *size_ret
= SBYTES (obj
);
1879 *data_ret
= SDATA (obj
);
1882 else if (SYMBOLP (obj
))
1886 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1887 (*data_ret
) [sizeof (Atom
)] = 0;
1888 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1889 if (NILP (type
)) type
= QATOM
;
1891 else if (INTEGERP (obj
)
1892 && XINT (obj
) < 0xFFFF
1893 && XINT (obj
) > -0xFFFF)
1897 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1898 (*data_ret
) [sizeof (short)] = 0;
1899 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1900 if (NILP (type
)) type
= QINTEGER
;
1902 else if (INTEGERP (obj
)
1903 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1904 && (INTEGERP (XCDR (obj
))
1905 || (CONSP (XCDR (obj
))
1906 && INTEGERP (XCAR (XCDR (obj
)))))))
1910 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1911 (*data_ret
) [sizeof (long)] = 0;
1912 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1913 if (NILP (type
)) type
= QINTEGER
;
1915 else if (VECTORP (obj
))
1917 /* Lisp_Vectors may represent a set of ATOMs;
1918 a set of 16 or 32 bit INTEGERs;
1919 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1923 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1924 /* This vector is an ATOM set */
1926 if (NILP (type
)) type
= QATOM
;
1927 *size_ret
= XVECTOR (obj
)->size
;
1929 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1930 for (i
= 0; i
< *size_ret
; i
++)
1931 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1932 (*(Atom
**) data_ret
) [i
]
1933 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1935 Fsignal (Qerror
, /* Qselection_error */
1937 ("all elements of selection vector must have same type"),
1938 Fcons (obj
, Qnil
)));
1940 #if 0 /* #### MULTIPLE doesn't work yet */
1941 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1942 /* This vector is an ATOM_PAIR set */
1944 if (NILP (type
)) type
= QATOM_PAIR
;
1945 *size_ret
= XVECTOR (obj
)->size
;
1947 *data_ret
= (unsigned char *)
1948 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1949 for (i
= 0; i
< *size_ret
; i
++)
1950 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1952 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1953 if (XVECTOR (pair
)->size
!= 2)
1956 ("elements of the vector must be vectors of exactly two elements"),
1957 Fcons (pair
, Qnil
)));
1959 (*(Atom
**) data_ret
) [i
* 2]
1960 = symbol_to_x_atom (dpyinfo
, display
,
1961 XVECTOR (pair
)->contents
[0]);
1962 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1963 = symbol_to_x_atom (dpyinfo
, display
,
1964 XVECTOR (pair
)->contents
[1]);
1969 ("all elements of the vector must be of the same type"),
1970 Fcons (obj
, Qnil
)));
1975 /* This vector is an INTEGER set, or something like it */
1977 *size_ret
= XVECTOR (obj
)->size
;
1978 if (NILP (type
)) type
= QINTEGER
;
1980 for (i
= 0; i
< *size_ret
; i
++)
1981 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1983 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1984 Fsignal (Qerror
, /* Qselection_error */
1986 ("elements of selection vector must be integers or conses of integers"),
1987 Fcons (obj
, Qnil
)));
1989 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1990 for (i
= 0; i
< *size_ret
; i
++)
1991 if (*format_ret
== 32)
1992 (*((unsigned long **) data_ret
)) [i
]
1993 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1995 (*((unsigned short **) data_ret
)) [i
]
1996 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
2000 Fsignal (Qerror
, /* Qselection_error */
2001 Fcons (build_string ("unrecognised selection data"),
2002 Fcons (obj
, Qnil
)));
2004 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
2008 clean_local_selection_data (obj
)
2012 && INTEGERP (XCAR (obj
))
2013 && CONSP (XCDR (obj
))
2014 && INTEGERP (XCAR (XCDR (obj
)))
2015 && NILP (XCDR (XCDR (obj
))))
2016 obj
= Fcons (XCAR (obj
), XCDR (obj
));
2019 && INTEGERP (XCAR (obj
))
2020 && INTEGERP (XCDR (obj
)))
2022 if (XINT (XCAR (obj
)) == 0)
2024 if (XINT (XCAR (obj
)) == -1)
2025 return make_number (- XINT (XCDR (obj
)));
2030 int size
= XVECTOR (obj
)->size
;
2033 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
2034 copy
= Fmake_vector (make_number (size
), Qnil
);
2035 for (i
= 0; i
< size
; i
++)
2036 XVECTOR (copy
)->contents
[i
]
2037 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
2043 /* Called from XTread_socket to handle SelectionNotify events.
2044 If it's the selection we are waiting for, stop waiting
2045 by setting the car of reading_selection_reply to non-nil.
2046 We store t there if the reply is successful, lambda if not. */
2049 x_handle_selection_notify (event
)
2050 XSelectionEvent
*event
;
2052 if (event
->requestor
!= reading_selection_window
)
2054 if (event
->selection
!= reading_which_selection
)
2057 TRACE0 ("Received SelectionNotify");
2058 XSETCAR (reading_selection_reply
,
2059 (event
->property
!= 0 ? Qt
: Qlambda
));
2063 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2064 Sx_own_selection_internal
, 2, 2, 0,
2065 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2066 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2067 \(Those are literal upper-case symbol names, since that's what X expects.)
2068 VALUE is typically a string, or a cons of two markers, but may be
2069 anything that the functions on `selection-converter-alist' know about. */)
2070 (selection_name
, selection_value
)
2071 Lisp_Object selection_name
, selection_value
;
2074 CHECK_SYMBOL (selection_name
);
2075 if (NILP (selection_value
)) error ("selection-value may not be nil");
2076 x_own_selection (selection_name
, selection_value
);
2077 return selection_value
;
2081 /* Request the selection value from the owner. If we are the owner,
2082 simply return our selection value. If we are not the owner, this
2083 will block until all of the data has arrived. */
2085 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2086 Sx_get_selection_internal
, 2, 3, 0,
2087 doc
: /* Return text selected from some X window.
2088 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2089 \(Those are literal upper-case symbol names, since that's what X expects.)
2090 TYPE is the type of data desired, typically `STRING'.
2091 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2092 selections. If omitted, defaults to the time for the last event. */)
2093 (selection_symbol
, target_type
, time_stamp
)
2094 Lisp_Object selection_symbol
, target_type
, time_stamp
;
2096 Lisp_Object val
= Qnil
;
2097 struct gcpro gcpro1
, gcpro2
;
2098 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2100 CHECK_SYMBOL (selection_symbol
);
2102 #if 0 /* #### MULTIPLE doesn't work yet */
2103 if (CONSP (target_type
)
2104 && XCAR (target_type
) == QMULTIPLE
)
2106 CHECK_VECTOR (XCDR (target_type
));
2107 /* So we don't destructively modify this... */
2108 target_type
= copy_multiple_data (target_type
);
2112 CHECK_SYMBOL (target_type
);
2114 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2118 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2123 && SYMBOLP (XCAR (val
)))
2126 if (CONSP (val
) && NILP (XCDR (val
)))
2129 val
= clean_local_selection_data (val
);
2135 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2136 Sx_disown_selection_internal
, 1, 2, 0,
2137 doc
: /* If we own the selection SELECTION, disown it.
2138 Disowning it means there is no such selection. */)
2140 Lisp_Object selection
;
2144 Atom selection_atom
;
2145 struct selection_input_event event
;
2147 struct x_display_info
*dpyinfo
;
2148 struct frame
*sf
= SELECTED_FRAME ();
2151 if (! FRAME_X_P (sf
))
2154 display
= FRAME_X_DISPLAY (sf
);
2155 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2156 CHECK_SYMBOL (selection
);
2158 timestamp
= last_event_timestamp
;
2160 timestamp
= cons_to_long (time
);
2162 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2163 return Qnil
; /* Don't disown the selection when we're not the owner. */
2165 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2168 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2171 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2172 generated for a window which owns the selection when that window sets
2173 the selection owner to None. The NCD server does, the MIT Sun4 server
2174 doesn't. So we synthesize one; this means we might get two, but
2175 that's ok, because the second one won't have any effect. */
2176 SELECTION_EVENT_DISPLAY (&event
) = display
;
2177 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2178 SELECTION_EVENT_TIME (&event
) = timestamp
;
2179 x_handle_selection_clear ((struct input_event
*) &event
);
2184 /* Get rid of all the selections in buffer BUFFER.
2185 This is used when we kill a buffer. */
2188 x_disown_buffer_selections (buffer
)
2192 struct buffer
*buf
= XBUFFER (buffer
);
2194 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2196 Lisp_Object elt
, value
;
2199 if (CONSP (value
) && MARKERP (XCAR (value
))
2200 && XMARKER (XCAR (value
))->buffer
== buf
)
2201 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2205 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2207 doc
: /* Whether the current Emacs process owns the given X Selection.
2208 The arg should be the name of the selection in question, typically one of
2209 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2210 \(Those are literal upper-case symbol names, since that's what X expects.)
2211 For convenience, the symbol nil is the same as `PRIMARY',
2212 and t is the same as `SECONDARY'. */)
2214 Lisp_Object selection
;
2217 CHECK_SYMBOL (selection
);
2218 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2219 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2221 if (NILP (Fassq (selection
, Vselection_alist
)))
2226 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2228 doc
: /* Whether there is an owner for the given X Selection.
2229 The arg should be the name of the selection in question, typically one of
2230 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2231 \(Those are literal upper-case symbol names, since that's what X expects.)
2232 For convenience, the symbol nil is the same as `PRIMARY',
2233 and t is the same as `SECONDARY'. */)
2235 Lisp_Object selection
;
2240 struct frame
*sf
= SELECTED_FRAME ();
2242 /* It should be safe to call this before we have an X frame. */
2243 if (! FRAME_X_P (sf
))
2246 dpy
= FRAME_X_DISPLAY (sf
);
2247 CHECK_SYMBOL (selection
);
2248 if (!NILP (Fx_selection_owner_p (selection
)))
2250 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2251 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2252 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2256 owner
= XGetSelectionOwner (dpy
, atom
);
2258 return (owner
? Qt
: Qnil
);
2262 #ifdef CUT_BUFFER_SUPPORT
2264 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2266 initialize_cut_buffers (display
, window
)
2270 unsigned char *data
= (unsigned char *) "";
2272 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2273 PropModeAppend, data, 0)
2274 FROB (XA_CUT_BUFFER0
);
2275 FROB (XA_CUT_BUFFER1
);
2276 FROB (XA_CUT_BUFFER2
);
2277 FROB (XA_CUT_BUFFER3
);
2278 FROB (XA_CUT_BUFFER4
);
2279 FROB (XA_CUT_BUFFER5
);
2280 FROB (XA_CUT_BUFFER6
);
2281 FROB (XA_CUT_BUFFER7
);
2287 #define CHECK_CUT_BUFFER(symbol) \
2288 { CHECK_SYMBOL ((symbol)); \
2289 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2290 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2291 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2292 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2294 Fcons (build_string ("doesn't name a cut buffer"), \
2295 Fcons ((symbol), Qnil))); \
2298 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2299 Sx_get_cut_buffer_internal
, 1, 1, 0,
2300 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2306 unsigned char *data
;
2313 struct x_display_info
*dpyinfo
;
2314 struct frame
*sf
= SELECTED_FRAME ();
2318 if (! FRAME_X_P (sf
))
2321 display
= FRAME_X_DISPLAY (sf
);
2322 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2323 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2324 CHECK_CUT_BUFFER (buffer
);
2325 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2327 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2328 &type
, &format
, &size
, 0);
2329 if (!data
|| !format
)
2332 if (format
!= 8 || type
!= XA_STRING
)
2334 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2335 Fcons (x_atom_to_symbol (display
, type
),
2336 Fcons (make_number (format
), Qnil
))));
2338 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2339 /* Use xfree, not XFree, because x_get_window_property
2340 calls xmalloc itself. */
2346 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2347 Sx_store_cut_buffer_internal
, 2, 2, 0,
2348 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2350 Lisp_Object buffer
, string
;
2354 unsigned char *data
;
2356 int bytes_remaining
;
2359 struct frame
*sf
= SELECTED_FRAME ();
2363 if (! FRAME_X_P (sf
))
2366 display
= FRAME_X_DISPLAY (sf
);
2367 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2369 max_bytes
= SELECTION_QUANTUM (display
);
2370 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2371 max_bytes
= MAX_SELECTION_QUANTUM
;
2373 CHECK_CUT_BUFFER (buffer
);
2374 CHECK_STRING (string
);
2375 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2377 data
= (unsigned char *) SDATA (string
);
2378 bytes
= SBYTES (string
);
2379 bytes_remaining
= bytes
;
2381 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2383 initialize_cut_buffers (display
, window
);
2384 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2389 /* Don't mess up with an empty value. */
2390 if (!bytes_remaining
)
2391 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2392 PropModeReplace
, data
, 0);
2394 while (bytes_remaining
)
2396 int chunk
= (bytes_remaining
< max_bytes
2397 ? bytes_remaining
: max_bytes
);
2398 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2399 (bytes_remaining
== bytes
2404 bytes_remaining
-= chunk
;
2411 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2412 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2413 doc
: /* Rotate the values of the cut buffers by the given number of step.
2414 Positive means shift the values forward, negative means backward. */)
2421 struct frame
*sf
= SELECTED_FRAME ();
2425 if (! FRAME_X_P (sf
))
2428 display
= FRAME_X_DISPLAY (sf
);
2429 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2433 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2435 initialize_cut_buffers (display
, window
);
2436 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2439 props
[0] = XA_CUT_BUFFER0
;
2440 props
[1] = XA_CUT_BUFFER1
;
2441 props
[2] = XA_CUT_BUFFER2
;
2442 props
[3] = XA_CUT_BUFFER3
;
2443 props
[4] = XA_CUT_BUFFER4
;
2444 props
[5] = XA_CUT_BUFFER5
;
2445 props
[6] = XA_CUT_BUFFER6
;
2446 props
[7] = XA_CUT_BUFFER7
;
2448 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2455 /***********************************************************************
2456 Drag and drop support
2457 ***********************************************************************/
2458 /* Check that lisp values are of correct type for x_fill_property_data.
2459 That is, number, string or a cons with two numbers (low and high 16
2460 bit parts of a 32 bit number). */
2463 x_check_property_data (data
)
2469 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2471 Lisp_Object o
= XCAR (iter
);
2473 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2475 else if (CONSP (o
) &&
2476 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2483 /* Convert lisp values to a C array. Values may be a number, a string
2484 which is taken as an X atom name and converted to the atom value, or
2485 a cons containing the two 16 bit parts of a 32 bit number.
2487 DPY is the display use to look up X atoms.
2488 DATA is a Lisp list of values to be converted.
2489 RET is the C array that contains the converted values. It is assumed
2490 it is big enough to hol all values.
2491 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2492 be stored in RET. */
2495 x_fill_property_data (dpy
, data
, ret
, format
)
2502 CARD32
*d32
= (CARD32
*) ret
;
2503 CARD16
*d16
= (CARD16
*) ret
;
2504 CARD8
*d08
= (CARD8
*) ret
;
2507 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2509 Lisp_Object o
= XCAR (iter
);
2512 val
= (CARD32
) XFASTINT (o
);
2513 else if (FLOATP (o
))
2514 val
= (CARD32
) XFLOAT (o
);
2516 val
= (CARD32
) cons_to_long (o
);
2517 else if (STRINGP (o
))
2520 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2524 error ("Wrong type, must be string, number or cons");
2527 *d08
++ = (CARD8
) val
;
2528 else if (format
== 16)
2529 *d16
++ = (CARD16
) val
;
2535 /* Convert an array of C values to a Lisp list.
2536 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2537 DATA is a C array of values to be converted.
2538 TYPE is the type of the data. Only XA_ATOM is special, it converts
2539 each number in DATA to its corresponfing X atom as a symbol.
2540 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2542 SIZE is the number of elements in DATA.
2544 Also see comment for selection_data_to_lisp_data above. */
2547 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2549 unsigned char *data
;
2554 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2555 data
, size
*format
/8, type
, format
);
2558 /* Get the mouse position frame relative coordinates. */
2561 mouse_position_for_drop (f
, x
, y
)
2566 Window root
, dummy_window
;
2571 XQueryPointer (FRAME_X_DISPLAY (f
),
2572 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2574 /* The root window which contains the pointer. */
2577 /* Window pointer is on, not used */
2580 /* The position on that root window. */
2583 /* x/y in dummy_window coordinates, not used. */
2586 /* Modifier keys and pointer buttons, about which
2588 (unsigned int *) &dummy
);
2591 /* Absolute to relative. */
2592 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2593 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2598 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2599 Sx_get_atom_name
, 1, 2, 0,
2600 doc
: /* Return the X atom name for VALUE as a string.
2601 VALUE may be a number or a cons where the car is the upper 16 bits and
2602 the cdr is the lower 16 bits of a 32 bit value.
2603 Use the display for FRAME or the current frame if FRAME is not given or nil.
2605 If the value is 0 or the atom is not known, return the empty string. */)
2607 Lisp_Object value
, frame
;
2609 struct frame
*f
= check_x_frame (frame
);
2611 Lisp_Object ret
= Qnil
;
2613 Display
*dpy
= FRAME_X_DISPLAY (f
);
2616 if (INTEGERP (value
))
2617 atom
= (Atom
) XUINT (value
);
2618 else if (FLOATP (value
))
2619 atom
= (Atom
) XFLOAT (value
);
2620 else if (CONSP (value
))
2621 atom
= (Atom
) cons_to_long (value
);
2623 error ("Wrong type, value must be number or cons");
2626 count
= x_catch_errors (dpy
);
2628 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2630 if (! x_had_errors_p (dpy
))
2631 ret
= make_string (name
, strlen (name
));
2633 x_uncatch_errors (dpy
, count
);
2635 if (atom
&& name
) XFree (name
);
2636 if (NILP (ret
)) ret
= make_string ("", 0);
2643 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2644 TODO: Check if this client event really is a DND event? */
2647 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2649 XClientMessageEvent
*event
;
2650 struct x_display_info
*dpyinfo
;
2651 struct input_event
*bufp
;
2655 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2658 XSETFRAME (frame
, f
);
2660 vec
= Fmake_vector (make_number (4), Qnil
);
2661 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2662 event
->message_type
));
2663 AREF (vec
, 1) = frame
;
2664 AREF (vec
, 2) = make_number (event
->format
);
2665 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2667 event
->message_type
,
2671 mouse_position_for_drop (f
, &x
, &y
);
2672 bufp
->kind
= DRAG_N_DROP_EVENT
;
2673 bufp
->frame_or_window
= Fcons (frame
, vec
);
2674 bufp
->timestamp
= CurrentTime
;
2675 bufp
->x
= make_number (x
);
2676 bufp
->y
= make_number (y
);
2678 bufp
->modifiers
= 0;
2683 DEFUN ("x-send-client-message", Fx_send_client_event
,
2684 Sx_send_client_message
, 6, 6, 0,
2685 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2687 For DISPLAY, specify either a frame or a display name (a string).
2688 If DISPLAY is nil, that stands for the selected frame's display.
2689 DEST may be a number, in which case it is a Window id. The value 0 may
2690 be used to send to the root window of the DISPLAY.
2691 If DEST is a cons, it is converted to a 32 bit number
2692 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2693 number is then used as a window id.
2694 If DEST is a frame the event is sent to the outer window of that frame.
2695 Nil means the currently selected frame.
2696 If DEST is the string "PointerWindow" the event is sent to the window that
2697 contains the pointer. If DEST is the string "InputFocus" the event is
2698 sent to the window that has the input focus.
2699 FROM is the frame sending the event. Use nil for currently selected frame.
2700 MESSAGE-TYPE is the name of an Atom as a string.
2701 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2702 bits. VALUES is a list of numbers, cons and/or strings containing the values
2703 to send. If a value is a string, it is converted to an Atom and the value of
2704 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2705 with the high 16 bits from the car and the lower 16 bit from the cdr.
2706 If more values than fits into the event is given, the excessive values
2708 (display
, dest
, from
, message_type
, format
, values
)
2709 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2711 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2716 struct frame
*f
= check_x_frame (from
);
2720 CHECK_STRING (message_type
);
2721 CHECK_NUMBER (format
);
2722 CHECK_CONS (values
);
2724 if (x_check_property_data (values
) == -1)
2725 error ("Bad data in VALUES, must be number, cons or string");
2727 event
.xclient
.type
= ClientMessage
;
2728 event
.xclient
.format
= XFASTINT (format
);
2730 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2731 && event
.xclient
.format
!= 32)
2732 error ("FORMAT must be one of 8, 16 or 32");
2734 if (FRAMEP (dest
) || NILP (dest
))
2736 struct frame
*fdest
= check_x_frame (dest
);
2737 wdest
= FRAME_OUTER_WINDOW (fdest
);
2739 else if (STRINGP (dest
))
2741 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2742 wdest
= PointerWindow
;
2743 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2746 error ("DEST as a string must be one of PointerWindow or InputFocus");
2748 else if (INTEGERP (dest
))
2749 wdest
= (Window
) XFASTINT (dest
);
2750 else if (FLOATP (dest
))
2751 wdest
= (Window
) XFLOAT (dest
);
2752 else if (CONSP (dest
))
2754 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2755 error ("Both car and cdr for DEST must be numbers");
2757 wdest
= (Window
) cons_to_long (dest
);
2760 error ("DEST must be a frame, nil, string, number or cons");
2762 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2763 to_root
= wdest
== dpyinfo
->root_window
;
2765 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2770 event
.xclient
.message_type
2771 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2772 event
.xclient
.display
= dpyinfo
->display
;
2774 /* Some clients (metacity for example) expects sending window to be here
2775 when sending to the root window. */
2776 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2778 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2779 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2780 event
.xclient
.format
);
2782 /* If event mask is 0 the event is sent to the client that created
2783 the destination window. But if we are sending to the root window,
2784 there is no such client. Then we set the event mask to 0xffff. The
2785 event then goes to clients selecting for events on the root window. */
2786 count
= x_catch_errors (dpyinfo
->display
);
2788 int propagate
= to_root
? False
: True
;
2789 unsigned mask
= to_root
? 0xffff : 0;
2790 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2791 XFlush (dpyinfo
->display
);
2793 x_uncatch_errors (dpyinfo
->display
, count
);
2803 defsubr (&Sx_get_selection_internal
);
2804 defsubr (&Sx_own_selection_internal
);
2805 defsubr (&Sx_disown_selection_internal
);
2806 defsubr (&Sx_selection_owner_p
);
2807 defsubr (&Sx_selection_exists_p
);
2809 #ifdef CUT_BUFFER_SUPPORT
2810 defsubr (&Sx_get_cut_buffer_internal
);
2811 defsubr (&Sx_store_cut_buffer_internal
);
2812 defsubr (&Sx_rotate_cut_buffers_internal
);
2815 defsubr (&Sx_get_atom_name
);
2816 defsubr (&Sx_send_client_message
);
2818 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2819 staticpro (&reading_selection_reply
);
2820 reading_selection_window
= 0;
2821 reading_which_selection
= 0;
2823 property_change_wait_list
= 0;
2824 prop_location_identifier
= 0;
2825 property_change_reply
= Fcons (Qnil
, Qnil
);
2826 staticpro (&property_change_reply
);
2828 Vselection_alist
= Qnil
;
2829 staticpro (&Vselection_alist
);
2831 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2832 doc
: /* An alist associating X Windows selection-types with functions.
2833 These functions are called to convert the selection, with three args:
2834 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2835 a desired type to which the selection should be converted;
2836 and the local selection value (whatever was given to `x-own-selection').
2838 The function should return the value to send to the X server
2839 \(typically a string). A return value of nil
2840 means that the conversion could not be done.
2841 A return value which is the symbol `NULL'
2842 means that a side-effect was executed,
2843 and there is no meaningful selection value. */);
2844 Vselection_converter_alist
= Qnil
;
2846 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions
,
2847 doc
: /* A list of functions to be called when Emacs loses an X selection.
2848 \(This happens when some other X client makes its own selection
2849 or when a Lisp program explicitly clears the selection.)
2850 The functions are called with one argument, the selection type
2851 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2852 Vx_lost_selection_functions
= Qnil
;
2854 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions
,
2855 doc
: /* A list of functions to be called when Emacs answers a selection request.
2856 The functions are called with four arguments:
2857 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2858 - the selection-type which Emacs was asked to convert the
2859 selection into before sending (for example, `STRING' or `LENGTH');
2860 - a flag indicating success or failure for responding to the request.
2861 We might have failed (and declined the request) for any number of reasons,
2862 including being asked for a selection that we no longer own, or being asked
2863 to convert into a type that we don't know about or that is inappropriate.
2864 This hook doesn't let you change the behavior of Emacs's selection replies,
2865 it merely informs you that they have happened. */);
2866 Vx_sent_selection_functions
= Qnil
;
2868 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2869 doc
: /* Coding system for communicating with other X clients.
2870 When sending or receiving text via cut_buffer, selection, and clipboard,
2871 the text is encoded or decoded by this coding system.
2872 The default value is `compound-text-with-extensions'. */);
2873 Vselection_coding_system
= intern ("compound-text-with-extensions");
2875 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2876 doc
: /* Coding system for the next communication with other X clients.
2877 Usually, `selection-coding-system' is used for communicating with
2878 other X clients. But, if this variable is set, it is used for the
2879 next communication only. After the communication, this variable is
2881 Vnext_selection_coding_system
= Qnil
;
2883 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2884 doc
: /* Number of milliseconds to wait for a selection reply.
2885 If the selection owner doesn't reply in this time, we give up.
2886 A value of 0 means wait as long as necessary. This is initialized from the
2887 \"*selectionTimeout\" resource. */);
2888 x_selection_timeout
= 0;
2890 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2891 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2892 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2893 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2894 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2895 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2896 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2897 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2898 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2899 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2900 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2901 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2902 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2903 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2904 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2905 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2906 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2907 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2908 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2909 staticpro (&Qcompound_text_with_extensions
);
2911 #ifdef CUT_BUFFER_SUPPORT
2912 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2913 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2914 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2915 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2916 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2917 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2918 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2919 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2922 Qforeign_selection
= intern ("foreign-selection");
2923 staticpro (&Qforeign_selection
);
2926 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2927 (do not change this comment) */