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 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
36 #include "xterm.h" /* for all of the X includes */
37 #include "dispextern.h" /* frame.h seems to want this */
38 #include "frame.h" /* Need this to get the X window of selected_frame */
39 #include "blockinput.h"
42 #include "termhooks.h"
45 #include <X11/Xproto.h>
49 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
50 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
52 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
53 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
54 static void x_decline_selection_request
P_ ((struct input_event
*));
55 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
56 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
57 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
58 static void x_reply_selection_request
P_ ((struct input_event
*, int,
59 unsigned char *, int, Atom
));
60 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
61 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
63 static void unexpect_property_change
P_ ((struct prop_location
*));
64 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
65 static void wait_for_property_change
P_ ((struct prop_location
*));
66 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
,
69 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
70 unsigned char **, int *,
71 Atom
*, int *, unsigned long *, int));
72 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
73 Lisp_Object
, unsigned,
74 unsigned char **, int *,
75 Atom
*, int *, unsigned long *));
76 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
79 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
81 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
82 unsigned char **, Atom
*,
83 unsigned *, int *, int *));
84 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
85 static void initialize_cut_buffers
P_ ((Display
*, Window
));
88 /* Printing traces to stderr. */
90 #ifdef TRACE_SELECTION
92 fprintf (stderr, "%d: " fmt "\n", getpid ())
93 #define TRACE1(fmt, a0) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
95 #define TRACE2(fmt, a0, a1) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
97 #define TRACE3(fmt, a0, a1, a2) \
98 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
100 #define TRACE0(fmt) (void) 0
101 #define TRACE1(fmt, a0) (void) 0
102 #define TRACE2(fmt, a0, a1) (void) 0
103 #define TRACE3(fmt, a0, a1) (void) 0
107 #define CUT_BUFFER_SUPPORT
109 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
110 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
113 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
114 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
116 Lisp_Object Qcompound_text_with_extensions
;
118 #ifdef CUT_BUFFER_SUPPORT
119 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
120 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
123 static Lisp_Object Vx_lost_selection_functions
;
124 static Lisp_Object Vx_sent_selection_functions
;
125 /* Coding system for communicating with other X clients via cutbuffer,
126 selection, and clipboard. */
127 static Lisp_Object Vselection_coding_system
;
129 /* Coding system for the next communicating with other X clients. */
130 static Lisp_Object Vnext_selection_coding_system
;
132 static Lisp_Object Qforeign_selection
;
134 /* If this is a smaller number than the max-request-size of the display,
135 emacs will use INCR selection transfer when the selection is larger
136 than this. The max-request-size is usually around 64k, so if you want
137 emacs to use incremental selection transfers when the selection is
138 smaller than that, set this. I added this mostly for debugging the
139 incremental transfer stuff, but it might improve server performance. */
140 #define MAX_SELECTION_QUANTUM 0xFFFFFF
143 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
145 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
148 /* The timestamp of the last input event Emacs received from the X server. */
149 /* Defined in keyboard.c. */
150 extern unsigned long last_event_timestamp
;
152 /* This is an association list whose elements are of the form
153 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
154 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
155 SELECTION-VALUE is the value that emacs owns for that selection.
156 It may be any kind of Lisp object.
157 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
158 as a cons of two 16-bit numbers (making a 32 bit time.)
159 FRAME is the frame for which we made the selection.
160 If there is an entry in this alist, then it can be assumed that Emacs owns
162 The only (eq) parts of this list that are visible from Lisp are the
164 static Lisp_Object Vselection_alist
;
166 /* This is an alist whose CARs are selection-types (whose names are the same
167 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
168 call to convert the given Emacs selection value to a string representing
169 the given selection type. This is for Lisp-level extension of the emacs
170 selection handling. */
171 static Lisp_Object Vselection_converter_alist
;
173 /* If the selection owner takes too long to reply to a selection request,
174 we give up on it. This is in milliseconds (0 = no timeout.) */
175 static EMACS_INT x_selection_timeout
;
177 /* Utility functions */
179 static void lisp_data_to_selection_data ();
180 static Lisp_Object
selection_data_to_lisp_data ();
181 static Lisp_Object
x_get_window_property_as_lisp_data ();
185 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
188 struct selection_event_queue
190 struct input_event event
;
191 struct selection_event_queue
*next
;
194 static struct selection_event_queue
*selection_queue
;
196 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
198 static int x_queue_selection_requests
;
200 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
203 x_queue_event (event
)
204 struct input_event
*event
;
206 struct selection_event_queue
*queue_tmp
;
208 /* Don't queue repeated requests.
209 This only happens for large requests which uses the incremental protocol. */
210 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
212 if (!bcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
214 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
215 x_decline_selection_request (event
);
221 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
223 if (queue_tmp
!= NULL
)
225 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
226 queue_tmp
->event
= *event
;
227 queue_tmp
->next
= selection_queue
;
228 selection_queue
= queue_tmp
;
232 /* Start queuing SELECTION_REQUEST_EVENT events. */
235 x_start_queuing_selection_requests ()
237 if (x_queue_selection_requests
)
240 x_queue_selection_requests
++;
241 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
244 /* Stop queuing SELECTION_REQUEST_EVENT events. */
247 x_stop_queuing_selection_requests ()
249 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
250 --x_queue_selection_requests
;
252 /* Take all the queued events and put them back
253 so that they get processed afresh. */
255 while (selection_queue
!= NULL
)
257 struct selection_event_queue
*queue_tmp
= selection_queue
;
258 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
259 kbd_buffer_unget_event (&queue_tmp
->event
);
260 selection_queue
= queue_tmp
->next
;
261 xfree ((char *)queue_tmp
);
266 /* This converts a Lisp symbol to a server Atom, avoiding a server
267 roundtrip whenever possible. */
270 symbol_to_x_atom (dpyinfo
, display
, sym
)
271 struct x_display_info
*dpyinfo
;
276 if (NILP (sym
)) return 0;
277 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
278 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
279 if (EQ (sym
, QSTRING
)) return XA_STRING
;
280 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
281 if (EQ (sym
, QATOM
)) return XA_ATOM
;
282 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
283 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
284 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
285 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
286 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
287 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
288 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
289 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
290 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
291 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
292 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
293 #ifdef CUT_BUFFER_SUPPORT
294 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
295 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
296 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
297 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
298 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
299 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
300 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
301 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
303 if (!SYMBOLP (sym
)) abort ();
305 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
307 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
313 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
314 and calls to intern whenever possible. */
317 x_atom_to_symbol (dpy
, atom
)
321 struct x_display_info
*dpyinfo
;
340 #ifdef CUT_BUFFER_SUPPORT
360 dpyinfo
= x_display_info_for_display (dpy
);
361 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
363 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
365 if (atom
== dpyinfo
->Xatom_TEXT
)
367 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
368 return QCOMPOUND_TEXT
;
369 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
371 if (atom
== dpyinfo
->Xatom_DELETE
)
373 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
375 if (atom
== dpyinfo
->Xatom_INCR
)
377 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
379 if (atom
== dpyinfo
->Xatom_TARGETS
)
381 if (atom
== dpyinfo
->Xatom_NULL
)
385 str
= XGetAtomName (dpy
, atom
);
387 TRACE1 ("XGetAtomName --> %s", str
);
388 if (! str
) return Qnil
;
391 /* This was allocated by Xlib, so use XFree. */
397 /* Do protocol to assert ourself as a selection owner.
398 Update the Vselection_alist so that we can reply to later requests for
402 x_own_selection (selection_name
, selection_value
)
403 Lisp_Object selection_name
, selection_value
;
405 struct frame
*sf
= SELECTED_FRAME ();
406 Window selecting_window
;
408 Time time
= last_event_timestamp
;
410 struct x_display_info
*dpyinfo
;
413 if (! FRAME_X_P (sf
))
416 selecting_window
= FRAME_X_WINDOW (sf
);
417 display
= FRAME_X_DISPLAY (sf
);
418 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
420 CHECK_SYMBOL (selection_name
);
421 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
424 count
= x_catch_errors (display
);
425 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
426 x_check_errors (display
, "Can't set selection: %s");
427 x_uncatch_errors (display
, count
);
430 /* Now update the local cache */
432 Lisp_Object selection_time
;
433 Lisp_Object selection_data
;
434 Lisp_Object prev_value
;
436 selection_time
= long_to_cons ((unsigned long) time
);
437 selection_data
= Fcons (selection_name
,
438 Fcons (selection_value
,
439 Fcons (selection_time
,
440 Fcons (selected_frame
, Qnil
))));
441 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
443 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
445 /* If we already owned the selection, remove the old selection data.
446 Perhaps we should destructively modify it instead.
447 Don't use Fdelq as that may QUIT. */
448 if (!NILP (prev_value
))
450 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
451 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
452 if (EQ (prev_value
, Fcar (XCDR (rest
))))
454 XSETCDR (rest
, Fcdr (XCDR (rest
)));
461 /* Given a selection-name and desired type, look up our local copy of
462 the selection value and convert it to the type.
463 The value is nil or a string.
464 This function is used both for remote requests (LOCAL_REQUEST is zero)
465 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
467 This calls random Lisp code, and may signal or gc. */
470 x_get_local_selection (selection_symbol
, target_type
, local_request
)
471 Lisp_Object selection_symbol
, target_type
;
474 Lisp_Object local_value
;
475 Lisp_Object handler_fn
, value
, type
, check
;
478 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
480 if (NILP (local_value
)) return Qnil
;
482 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
483 if (EQ (target_type
, QTIMESTAMP
))
486 value
= XCAR (XCDR (XCDR (local_value
)));
489 else if (EQ (target_type
, QDELETE
))
492 Fx_disown_selection_internal
494 XCAR (XCDR (XCDR (local_value
))));
499 #if 0 /* #### MULTIPLE doesn't work yet */
500 else if (CONSP (target_type
)
501 && XCAR (target_type
) == QMULTIPLE
)
506 pairs
= XCDR (target_type
);
507 size
= XVECTOR (pairs
)->size
;
508 /* If the target is MULTIPLE, then target_type looks like
509 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
510 We modify the second element of each pair in the vector and
511 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
513 for (i
= 0; i
< size
; i
++)
516 pair
= XVECTOR (pairs
)->contents
[i
];
517 XVECTOR (pair
)->contents
[1]
518 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
519 XVECTOR (pair
)->contents
[1],
527 /* Don't allow a quit within the converter.
528 When the user types C-g, he would be surprised
529 if by luck it came during a converter. */
530 count
= SPECPDL_INDEX ();
531 specbind (Qinhibit_quit
, Qt
);
533 CHECK_SYMBOL (target_type
);
534 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
535 /* gcpro is not needed here since nothing but HANDLER_FN
536 is live, and that ought to be a symbol. */
538 if (!NILP (handler_fn
))
539 value
= call3 (handler_fn
,
540 selection_symbol
, (local_request
? Qnil
: target_type
),
541 XCAR (XCDR (local_value
)));
544 unbind_to (count
, Qnil
);
547 /* Make sure this value is of a type that we could transmit
548 to another X client. */
552 && SYMBOLP (XCAR (value
)))
554 check
= XCDR (value
);
562 /* Check for a value that cons_to_long could handle. */
563 else if (CONSP (check
)
564 && INTEGERP (XCAR (check
))
565 && (INTEGERP (XCDR (check
))
567 (CONSP (XCDR (check
))
568 && INTEGERP (XCAR (XCDR (check
)))
569 && NILP (XCDR (XCDR (check
))))))
574 Fcons (build_string ("invalid data returned by selection-conversion function"),
575 Fcons (handler_fn
, Fcons (value
, Qnil
))));
578 /* Subroutines of x_reply_selection_request. */
580 /* Send a SelectionNotify event to the requestor with property=None,
581 meaning we were unable to do what they wanted. */
584 x_decline_selection_request (event
)
585 struct input_event
*event
;
587 XSelectionEvent reply
;
590 reply
.type
= SelectionNotify
;
591 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
592 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
593 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
594 reply
.time
= SELECTION_EVENT_TIME (event
);
595 reply
.target
= SELECTION_EVENT_TARGET (event
);
596 reply
.property
= None
;
598 /* The reason for the error may be that the receiver has
599 died in the meantime. Handle that case. */
601 count
= x_catch_errors (reply
.display
);
602 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
603 XFlush (reply
.display
);
604 x_uncatch_errors (reply
.display
, count
);
608 /* This is the selection request currently being processed.
609 It is set to zero when the request is fully processed. */
610 static struct input_event
*x_selection_current_request
;
612 /* Display info in x_selection_request. */
614 static struct x_display_info
*selection_request_dpyinfo
;
616 /* Used as an unwind-protect clause so that, if a selection-converter signals
617 an error, we tell the requester that we were unable to do what they wanted
618 before we throw to top-level or go into the debugger or whatever. */
621 x_selection_request_lisp_error (ignore
)
624 if (x_selection_current_request
!= 0
625 && selection_request_dpyinfo
->display
)
626 x_decline_selection_request (x_selection_current_request
);
631 /* This stuff is so that INCR selections are reentrant (that is, so we can
632 be servicing multiple INCR selection requests simultaneously.) I haven't
633 actually tested that yet. */
635 /* Keep a list of the property changes that are awaited. */
645 struct prop_location
*next
;
648 static struct prop_location
*expect_property_change ();
649 static void wait_for_property_change ();
650 static void unexpect_property_change ();
651 static int waiting_for_other_props_on_window ();
653 static int prop_location_identifier
;
655 static Lisp_Object property_change_reply
;
657 static struct prop_location
*property_change_reply_object
;
659 static struct prop_location
*property_change_wait_list
;
662 queue_selection_requests_unwind (tem
)
665 x_stop_queuing_selection_requests ();
669 /* Return some frame whose display info is DPYINFO.
670 Return nil if there is none. */
673 some_frame_on_display (dpyinfo
)
674 struct x_display_info
*dpyinfo
;
676 Lisp_Object list
, frame
;
678 FOR_EACH_FRAME (list
, frame
)
680 if (FRAME_X_P (XFRAME (frame
))
681 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
688 /* Send the reply to a selection request event EVENT.
689 TYPE is the type of selection data requested.
690 DATA and SIZE describe the data to send, already converted.
691 FORMAT is the unit-size (in bits) of the data to be transmitted. */
694 x_reply_selection_request (event
, format
, data
, size
, type
)
695 struct input_event
*event
;
700 XSelectionEvent reply
;
701 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
702 Window window
= SELECTION_EVENT_REQUESTOR (event
);
704 int format_bytes
= format
/8;
705 int max_bytes
= SELECTION_QUANTUM (display
);
706 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
709 if (max_bytes
> MAX_SELECTION_QUANTUM
)
710 max_bytes
= MAX_SELECTION_QUANTUM
;
712 reply
.type
= SelectionNotify
;
713 reply
.display
= display
;
714 reply
.requestor
= window
;
715 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
716 reply
.time
= SELECTION_EVENT_TIME (event
);
717 reply
.target
= SELECTION_EVENT_TARGET (event
);
718 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
719 if (reply
.property
== None
)
720 reply
.property
= reply
.target
;
722 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
724 count
= x_catch_errors (display
);
726 #ifdef TRACE_SELECTION
729 char *sel
= XGetAtomName (display
, reply
.selection
);
730 char *tgt
= XGetAtomName (display
, reply
.target
);
731 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++cnt
);
732 if (sel
) XFree (sel
);
733 if (tgt
) XFree (tgt
);
735 #endif /* TRACE_SELECTION */
737 /* Store the data on the requested property.
738 If the selection is large, only store the first N bytes of it.
740 bytes_remaining
= size
* format_bytes
;
741 if (bytes_remaining
<= max_bytes
)
743 /* Send all the data at once, with minimal handshaking. */
744 TRACE1 ("Sending all %d bytes", bytes_remaining
);
745 XChangeProperty (display
, window
, reply
.property
, type
, format
,
746 PropModeReplace
, data
, size
);
747 /* At this point, the selection was successfully stored; ack it. */
748 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
752 /* Send an INCR selection. */
753 struct prop_location
*wait_object
;
757 frame
= some_frame_on_display (dpyinfo
);
759 /* If the display no longer has frames, we can't expect
760 to get many more selection requests from it, so don't
761 bother trying to queue them. */
764 x_start_queuing_selection_requests ();
766 record_unwind_protect (queue_selection_requests_unwind
,
770 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
771 error ("Attempt to transfer an INCR to ourself!");
773 TRACE2 ("Start sending %d bytes incrementally (%s)",
774 bytes_remaining
, XGetAtomName (display
, reply
.property
));
775 wait_object
= expect_property_change (display
, window
, reply
.property
,
778 TRACE1 ("Set %s to number of bytes to send",
779 XGetAtomName (display
, reply
.property
));
780 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
782 (unsigned char *) &bytes_remaining
, 1);
783 XSelectInput (display
, window
, PropertyChangeMask
);
785 /* Tell 'em the INCR data is there... */
786 TRACE0 ("Send SelectionNotify event");
787 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
790 had_errors
= x_had_errors_p (display
);
793 /* First, wait for the requester to ack by deleting the property.
794 This can run random lisp code (process handlers) or signal. */
797 TRACE1 ("Waiting for ACK (deletion of %s)",
798 XGetAtomName (display
, reply
.property
));
799 wait_for_property_change (wait_object
);
802 unexpect_property_change (wait_object
);
805 while (bytes_remaining
)
807 int i
= ((bytes_remaining
< max_bytes
)
814 = expect_property_change (display
, window
, reply
.property
,
817 TRACE1 ("Sending increment of %d bytes", i
);
818 TRACE1 ("Set %s to increment data",
819 XGetAtomName (display
, reply
.property
));
821 /* Append the next chunk of data to the property. */
822 XChangeProperty (display
, window
, reply
.property
, type
, format
,
823 PropModeAppend
, data
, i
/ format_bytes
);
824 bytes_remaining
-= i
;
827 had_errors
= x_had_errors_p (display
);
833 /* Now wait for the requester to ack this chunk by deleting the
834 property. This can run random lisp code or signal. */
835 TRACE1 ("Waiting for increment ACK (deletion of %s)",
836 XGetAtomName (display
, reply
.property
));
837 wait_for_property_change (wait_object
);
840 /* Now write a zero-length chunk to the property to tell the
841 requester that we're done. */
843 if (! waiting_for_other_props_on_window (display
, window
))
844 XSelectInput (display
, window
, 0L);
846 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
847 XGetAtomName (display
, reply
.property
));
848 XChangeProperty (display
, window
, reply
.property
, type
, format
,
849 PropModeReplace
, data
, 0);
850 TRACE0 ("Done sending incrementally");
853 /* rms, 2003-01-03: I think I have fixed this bug. */
854 /* The window we're communicating with may have been deleted
855 in the meantime (that's a real situation from a bug report).
856 In this case, there may be events in the event queue still
857 refering to the deleted window, and we'll get a BadWindow error
858 in XTread_socket when processing the events. I don't have
859 an idea how to fix that. gerd, 2001-01-98. */
860 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
861 delivered before uncatch errors. */
862 XSync (display
, False
);
865 /* GTK queues events in addition to the queue in Xlib. So we
866 UNBLOCK to enter the event loop and get possible errors delivered,
867 and then BLOCK again because x_uncatch_errors requires it. */
869 x_uncatch_errors (display
, count
);
873 /* Handle a SelectionRequest event EVENT.
874 This is called from keyboard.c when such an event is found in the queue. */
877 x_handle_selection_request (event
)
878 struct input_event
*event
;
880 struct gcpro gcpro1
, gcpro2
, gcpro3
;
881 Lisp_Object local_selection_data
;
882 Lisp_Object selection_symbol
;
883 Lisp_Object target_symbol
;
884 Lisp_Object converted_selection
;
885 Time local_selection_time
;
886 Lisp_Object successful_p
;
888 struct x_display_info
*dpyinfo
889 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
891 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
892 (unsigned long) SELECTION_EVENT_REQUESTOR (event
),
893 (unsigned long) SELECTION_EVENT_TIME (event
));
895 local_selection_data
= Qnil
;
896 target_symbol
= Qnil
;
897 converted_selection
= Qnil
;
900 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
902 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
903 SELECTION_EVENT_SELECTION (event
));
905 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
907 if (NILP (local_selection_data
))
909 /* Someone asked for the selection, but we don't have it any more.
911 x_decline_selection_request (event
);
915 local_selection_time
= (Time
)
916 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
918 if (SELECTION_EVENT_TIME (event
) != CurrentTime
919 && local_selection_time
> SELECTION_EVENT_TIME (event
))
921 /* Someone asked for the selection, and we have one, but not the one
924 x_decline_selection_request (event
);
928 x_selection_current_request
= event
;
929 count
= SPECPDL_INDEX ();
930 selection_request_dpyinfo
= dpyinfo
;
931 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
933 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
934 SELECTION_EVENT_TARGET (event
));
936 #if 0 /* #### MULTIPLE doesn't work yet */
937 if (EQ (target_symbol
, QMULTIPLE
))
938 target_symbol
= fetch_multiple_target (event
);
941 /* Convert lisp objects back into binary data */
944 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
946 if (! NILP (converted_selection
))
954 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
956 &data
, &type
, &size
, &format
, &nofree
);
958 x_reply_selection_request (event
, format
, data
, size
, type
);
961 /* Indicate we have successfully processed this event. */
962 x_selection_current_request
= 0;
964 /* Use xfree, not XFree, because lisp_data_to_selection_data
965 calls xmalloc itself. */
969 unbind_to (count
, Qnil
);
973 /* Let random lisp code notice that the selection has been asked for. */
976 rest
= Vx_sent_selection_functions
;
977 if (!EQ (rest
, Qunbound
))
978 for (; CONSP (rest
); rest
= Fcdr (rest
))
979 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
985 /* Handle a SelectionClear event EVENT, which indicates that some
986 client cleared out our previously asserted selection.
987 This is called from keyboard.c when such an event is found in the queue. */
990 x_handle_selection_clear (event
)
991 struct input_event
*event
;
993 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
994 Atom selection
= SELECTION_EVENT_SELECTION (event
);
995 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
997 Lisp_Object selection_symbol
, local_selection_data
;
998 Time local_selection_time
;
999 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1000 struct x_display_info
*t_dpyinfo
;
1002 TRACE0 ("x_handle_selection_clear");
1004 /* If the new selection owner is also Emacs,
1005 don't clear the new selection. */
1007 /* Check each display on the same terminal,
1008 to see if this Emacs job now owns the selection
1009 through that display. */
1010 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
1011 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
1014 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
1015 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
1023 selection_symbol
= x_atom_to_symbol (display
, selection
);
1025 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
1027 /* Well, we already believe that we don't own it, so that's just fine. */
1028 if (NILP (local_selection_data
)) return;
1030 local_selection_time
= (Time
)
1031 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
1033 /* This SelectionClear is for a selection that we no longer own, so we can
1034 disregard it. (That is, we have reasserted the selection since this
1035 request was generated.) */
1037 if (changed_owner_time
!= CurrentTime
1038 && local_selection_time
> changed_owner_time
)
1041 /* Otherwise, we're really honest and truly being told to drop it.
1042 Don't use Fdelq as that may QUIT;. */
1044 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
1045 Vselection_alist
= Fcdr (Vselection_alist
);
1049 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1050 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
1052 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1057 /* Let random lisp code notice that the selection has been stolen. */
1061 rest
= Vx_lost_selection_functions
;
1062 if (!EQ (rest
, Qunbound
))
1064 for (; CONSP (rest
); rest
= Fcdr (rest
))
1065 call1 (Fcar (rest
), selection_symbol
);
1066 prepare_menu_bars ();
1067 redisplay_preserve_echo_area (20);
1073 x_handle_selection_event (event
)
1074 struct input_event
*event
;
1076 TRACE0 ("x_handle_selection_event");
1078 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1080 if (x_queue_selection_requests
)
1081 x_queue_event (event
);
1083 x_handle_selection_request (event
);
1086 x_handle_selection_clear (event
);
1090 /* Clear all selections that were made from frame F.
1091 We do this when about to delete a frame. */
1094 x_clear_frame_selections (f
)
1100 XSETFRAME (frame
, f
);
1102 /* Otherwise, we're really honest and truly being told to drop it.
1103 Don't use Fdelq as that may QUIT;. */
1105 /* Delete elements from the beginning of Vselection_alist. */
1106 while (!NILP (Vselection_alist
)
1107 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1109 /* Let random Lisp code notice that the selection has been stolen. */
1110 Lisp_Object hooks
, selection_symbol
;
1112 hooks
= Vx_lost_selection_functions
;
1113 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1115 if (!EQ (hooks
, Qunbound
))
1117 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1118 call1 (Fcar (hooks
), selection_symbol
);
1119 #if 0 /* This can crash when deleting a frame
1120 from x_connection_closed. Anyway, it seems unnecessary;
1121 something else should cause a redisplay. */
1122 redisplay_preserve_echo_area (21);
1126 Vselection_alist
= Fcdr (Vselection_alist
);
1129 /* Delete elements after the beginning of Vselection_alist. */
1130 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
1131 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1133 /* Let random Lisp code notice that the selection has been stolen. */
1134 Lisp_Object hooks
, selection_symbol
;
1136 hooks
= Vx_lost_selection_functions
;
1137 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1139 if (!EQ (hooks
, Qunbound
))
1141 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1142 call1 (Fcar (hooks
), selection_symbol
);
1143 #if 0 /* See above */
1144 redisplay_preserve_echo_area (22);
1147 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1152 /* Nonzero if any properties for DISPLAY and WINDOW
1153 are on the list of what we are waiting for. */
1156 waiting_for_other_props_on_window (display
, window
)
1160 struct prop_location
*rest
= property_change_wait_list
;
1162 if (rest
->display
== display
&& rest
->window
== window
)
1169 /* Add an entry to the list of property changes we are waiting for.
1170 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1171 The return value is a number that uniquely identifies
1172 this awaited property change. */
1174 static struct prop_location
*
1175 expect_property_change (display
, window
, property
, state
)
1181 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1182 pl
->identifier
= ++prop_location_identifier
;
1183 pl
->display
= display
;
1184 pl
->window
= window
;
1185 pl
->property
= property
;
1186 pl
->desired_state
= state
;
1187 pl
->next
= property_change_wait_list
;
1189 property_change_wait_list
= pl
;
1193 /* Delete an entry from the list of property changes we are waiting for.
1194 IDENTIFIER is the number that uniquely identifies the entry. */
1197 unexpect_property_change (location
)
1198 struct prop_location
*location
;
1200 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1203 if (rest
== location
)
1206 prev
->next
= rest
->next
;
1208 property_change_wait_list
= rest
->next
;
1217 /* Remove the property change expectation element for IDENTIFIER. */
1220 wait_for_property_change_unwind (loc
)
1223 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1225 unexpect_property_change (location
);
1226 if (location
== property_change_reply_object
)
1227 property_change_reply_object
= 0;
1231 /* Actually wait for a property change.
1232 IDENTIFIER should be the value that expect_property_change returned. */
1235 wait_for_property_change (location
)
1236 struct prop_location
*location
;
1239 int count
= SPECPDL_INDEX ();
1241 if (property_change_reply_object
)
1244 /* Make sure to do unexpect_property_change if we quit or err. */
1245 record_unwind_protect (wait_for_property_change_unwind
,
1246 make_save_value (location
, 0));
1248 XSETCAR (property_change_reply
, Qnil
);
1249 property_change_reply_object
= location
;
1251 /* If the event we are waiting for arrives beyond here, it will set
1252 property_change_reply, because property_change_reply_object says so. */
1253 if (! location
->arrived
)
1255 secs
= x_selection_timeout
/ 1000;
1256 usecs
= (x_selection_timeout
% 1000) * 1000;
1257 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1258 wait_reading_process_output (secs
, usecs
, 0, 0,
1259 property_change_reply
, NULL
, 0);
1261 if (NILP (XCAR (property_change_reply
)))
1263 TRACE0 (" Timed out");
1264 error ("Timed out waiting for property-notify event");
1268 unbind_to (count
, Qnil
);
1271 /* Called from XTread_socket in response to a PropertyNotify event. */
1274 x_handle_property_notify (event
)
1275 XPropertyEvent
*event
;
1277 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1282 && rest
->property
== event
->atom
1283 && rest
->window
== event
->window
1284 && rest
->display
== event
->display
1285 && rest
->desired_state
== event
->state
)
1287 TRACE2 ("Expected %s of property %s",
1288 (event
->state
== PropertyDelete
? "deletion" : "change"),
1289 XGetAtomName (event
->display
, event
->atom
));
1293 /* If this is the one wait_for_property_change is waiting for,
1294 tell it to wake up. */
1295 if (rest
== property_change_reply_object
)
1296 XSETCAR (property_change_reply
, Qt
);
1308 #if 0 /* #### MULTIPLE doesn't work yet */
1311 fetch_multiple_target (event
)
1312 XSelectionRequestEvent
*event
;
1314 Display
*display
= event
->display
;
1315 Window window
= event
->requestor
;
1316 Atom target
= event
->target
;
1317 Atom selection_atom
= event
->selection
;
1322 x_get_window_property_as_lisp_data (display
, window
, target
,
1323 QMULTIPLE
, selection_atom
));
1327 copy_multiple_data (obj
)
1334 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1337 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1338 for (i
= 0; i
< size
; i
++)
1340 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1341 CHECK_VECTOR (vec2
);
1342 if (XVECTOR (vec2
)->size
!= 2)
1343 /* ??? Confusing error message */
1344 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1345 Fcons (vec2
, Qnil
)));
1346 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1347 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1348 = XVECTOR (vec2
)->contents
[0];
1349 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1350 = XVECTOR (vec2
)->contents
[1];
1358 /* Variables for communication with x_handle_selection_notify. */
1359 static Atom reading_which_selection
;
1360 static Lisp_Object reading_selection_reply
;
1361 static Window reading_selection_window
;
1363 /* Do protocol to read selection-data from the server.
1364 Converts this to Lisp data and returns it. */
1367 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1368 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1370 struct frame
*sf
= SELECTED_FRAME ();
1371 Window requestor_window
;
1373 struct x_display_info
*dpyinfo
;
1374 Time requestor_time
= last_event_timestamp
;
1375 Atom target_property
;
1376 Atom selection_atom
;
1382 if (! FRAME_X_P (sf
))
1385 requestor_window
= FRAME_X_WINDOW (sf
);
1386 display
= FRAME_X_DISPLAY (sf
);
1387 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1388 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1389 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1391 if (CONSP (target_type
))
1392 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1394 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1396 if (! NILP (time_stamp
))
1398 if (CONSP (time_stamp
))
1399 requestor_time
= (Time
) cons_to_long (time_stamp
);
1400 else if (INTEGERP (time_stamp
))
1401 requestor_time
= (Time
) XUINT (time_stamp
);
1402 else if (FLOATP (time_stamp
))
1403 requestor_time
= (Time
) XFLOAT (time_stamp
);
1405 error ("TIME_STAMP must be cons or number");
1410 count
= x_catch_errors (display
);
1412 TRACE2 ("Get selection %s, type %s",
1413 XGetAtomName (display
, type_atom
),
1414 XGetAtomName (display
, target_property
));
1416 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1417 requestor_window
, requestor_time
);
1420 /* Prepare to block until the reply has been read. */
1421 reading_selection_window
= requestor_window
;
1422 reading_which_selection
= selection_atom
;
1423 XSETCAR (reading_selection_reply
, Qnil
);
1425 frame
= some_frame_on_display (dpyinfo
);
1427 /* If the display no longer has frames, we can't expect
1428 to get many more selection requests from it, so don't
1429 bother trying to queue them. */
1432 x_start_queuing_selection_requests ();
1434 record_unwind_protect (queue_selection_requests_unwind
,
1439 /* This allows quits. Also, don't wait forever. */
1440 secs
= x_selection_timeout
/ 1000;
1441 usecs
= (x_selection_timeout
% 1000) * 1000;
1442 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1443 wait_reading_process_output (secs
, usecs
, 0, 0,
1444 reading_selection_reply
, NULL
, 0);
1445 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1448 x_check_errors (display
, "Cannot get selection: %s");
1449 x_uncatch_errors (display
, count
);
1452 if (NILP (XCAR (reading_selection_reply
)))
1453 error ("Timed out waiting for reply from selection owner");
1454 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1455 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1457 /* Otherwise, the selection is waiting for us on the requested property. */
1459 x_get_window_property_as_lisp_data (display
, requestor_window
,
1460 target_property
, target_type
,
1464 /* Subroutines of x_get_window_property_as_lisp_data */
1466 /* Use xfree, not XFree, to free the data obtained with this function. */
1469 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1470 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1475 unsigned char **data_ret
;
1477 Atom
*actual_type_ret
;
1478 int *actual_format_ret
;
1479 unsigned long *actual_size_ret
;
1483 unsigned long bytes_remaining
;
1485 unsigned char *tmp_data
= 0;
1487 int buffer_size
= SELECTION_QUANTUM (display
);
1489 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1490 buffer_size
= MAX_SELECTION_QUANTUM
;
1494 /* First probe the thing to find out how big it is. */
1495 result
= XGetWindowProperty (display
, window
, property
,
1496 0L, 0L, False
, AnyPropertyType
,
1497 actual_type_ret
, actual_format_ret
,
1499 &bytes_remaining
, &tmp_data
);
1500 if (result
!= Success
)
1508 /* This was allocated by Xlib, so use XFree. */
1509 XFree ((char *) tmp_data
);
1511 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1517 total_size
= bytes_remaining
+ 1;
1518 *data_ret
= (unsigned char *) xmalloc (total_size
);
1520 /* Now read, until we've gotten it all. */
1521 while (bytes_remaining
)
1523 #ifdef TRACE_SELECTION
1524 int last
= bytes_remaining
;
1527 = XGetWindowProperty (display
, window
, property
,
1528 (long)offset
/4, (long)buffer_size
/4,
1531 actual_type_ret
, actual_format_ret
,
1532 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1534 TRACE2 ("Read %ld bytes from property %s",
1535 last
- bytes_remaining
,
1536 XGetAtomName (display
, property
));
1538 /* If this doesn't return Success at this point, it means that
1539 some clod deleted the selection while we were in the midst of
1540 reading it. Deal with that, I guess.... */
1541 if (result
!= Success
)
1543 *actual_size_ret
*= *actual_format_ret
/ 8;
1544 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1545 offset
+= *actual_size_ret
;
1547 /* This was allocated by Xlib, so use XFree. */
1548 XFree ((char *) tmp_data
);
1553 *bytes_ret
= offset
;
1556 /* Use xfree, not XFree, to free the data obtained with this function. */
1559 receive_incremental_selection (display
, window
, property
, target_type
,
1560 min_size_bytes
, data_ret
, size_bytes_ret
,
1561 type_ret
, format_ret
, size_ret
)
1565 Lisp_Object target_type
; /* for error messages only */
1566 unsigned int min_size_bytes
;
1567 unsigned char **data_ret
;
1568 int *size_bytes_ret
;
1570 unsigned long *size_ret
;
1574 struct prop_location
*wait_object
;
1575 *size_bytes_ret
= min_size_bytes
;
1576 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1578 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1580 /* At this point, we have read an INCR property.
1581 Delete the property to ack it.
1582 (But first, prepare to receive the next event in this handshake.)
1584 Now, we must loop, waiting for the sending window to put a value on
1585 that property, then reading the property, then deleting it to ack.
1586 We are done when the sender places a property of length 0.
1589 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1590 TRACE1 (" Delete property %s",
1591 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1592 XDeleteProperty (display
, window
, property
);
1593 TRACE1 (" Expect new value of property %s",
1594 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1595 wait_object
= expect_property_change (display
, window
, property
,
1602 unsigned char *tmp_data
;
1605 TRACE0 (" Wait for property change");
1606 wait_for_property_change (wait_object
);
1608 /* expect it again immediately, because x_get_window_property may
1609 .. no it won't, I don't get it.
1610 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1611 TRACE0 (" Get property value");
1612 x_get_window_property (display
, window
, property
,
1613 &tmp_data
, &tmp_size_bytes
,
1614 type_ret
, format_ret
, size_ret
, 1);
1616 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1618 if (tmp_size_bytes
== 0) /* we're done */
1620 TRACE0 ("Done reading incrementally");
1622 if (! waiting_for_other_props_on_window (display
, window
))
1623 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1624 /* Use xfree, not XFree, because x_get_window_property
1625 calls xmalloc itself. */
1626 if (tmp_data
) xfree (tmp_data
);
1631 TRACE1 (" ACK by deleting property %s",
1632 XGetAtomName (display
, property
));
1633 XDeleteProperty (display
, window
, property
);
1634 wait_object
= expect_property_change (display
, window
, property
,
1639 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1641 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1642 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1645 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1646 offset
+= tmp_size_bytes
;
1648 /* Use xfree, not XFree, because x_get_window_property
1649 calls xmalloc itself. */
1655 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1656 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1657 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1660 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1665 Lisp_Object target_type
; /* for error messages only */
1666 Atom selection_atom
; /* for error messages only */
1670 unsigned long actual_size
;
1671 unsigned char *data
= 0;
1674 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1676 TRACE0 ("Reading selection data");
1678 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1679 &actual_type
, &actual_format
, &actual_size
, 1);
1682 int there_is_a_selection_owner
;
1684 there_is_a_selection_owner
1685 = XGetSelectionOwner (display
, selection_atom
);
1688 there_is_a_selection_owner
1689 ? Fcons (build_string ("selection owner couldn't convert"),
1691 ? Fcons (target_type
,
1692 Fcons (x_atom_to_symbol (display
,
1695 : Fcons (target_type
, Qnil
))
1696 : Fcons (build_string ("no selection"),
1697 Fcons (x_atom_to_symbol (display
,
1702 if (actual_type
== dpyinfo
->Xatom_INCR
)
1704 /* That wasn't really the data, just the beginning. */
1706 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1708 /* Use xfree, not XFree, because x_get_window_property
1709 calls xmalloc itself. */
1710 xfree ((char *) data
);
1712 receive_incremental_selection (display
, window
, property
, target_type
,
1713 min_size_bytes
, &data
, &bytes
,
1714 &actual_type
, &actual_format
,
1719 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1720 XDeleteProperty (display
, window
, property
);
1724 /* It's been read. Now convert it to a lisp object in some semi-rational
1726 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1727 actual_type
, actual_format
);
1729 /* Use xfree, not XFree, because x_get_window_property
1730 calls xmalloc itself. */
1731 xfree ((char *) data
);
1735 /* These functions convert from the selection data read from the server into
1736 something that we can use from Lisp, and vice versa.
1738 Type: Format: Size: Lisp Type:
1739 ----- ------- ----- -----------
1742 ATOM 32 > 1 Vector of Symbols
1744 * 16 > 1 Vector of Integers
1745 * 32 1 if <=16 bits: Integer
1746 if > 16 bits: Cons of top16, bot16
1747 * 32 > 1 Vector of the above
1749 When converting a Lisp number to C, it is assumed to be of format 16 if
1750 it is an integer, and of format 32 if it is a cons of two integers.
1752 When converting a vector of numbers from Lisp to C, it is assumed to be
1753 of format 16 if every element in the vector is an integer, and is assumed
1754 to be of format 32 if any element is a cons of two integers.
1756 When converting an object to C, it may be of the form (SYMBOL . <data>)
1757 where SYMBOL is what we should claim that the type is. Format and
1758 representation are as above. */
1763 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1765 unsigned char *data
;
1769 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1771 if (type
== dpyinfo
->Xatom_NULL
)
1774 /* Convert any 8-bit data to a string, for compactness. */
1775 else if (format
== 8)
1777 Lisp_Object str
, lispy_type
;
1779 str
= make_unibyte_string ((char *) data
, size
);
1780 /* Indicate that this string is from foreign selection by a text
1781 property `foreign-selection' so that the caller of
1782 x-get-selection-internal (usually x-get-selection) can know
1783 that the string must be decode. */
1784 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1785 lispy_type
= QCOMPOUND_TEXT
;
1786 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1787 lispy_type
= QUTF8_STRING
;
1789 lispy_type
= QSTRING
;
1790 Fput_text_property (make_number (0), make_number (size
),
1791 Qforeign_selection
, lispy_type
, str
);
1794 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1795 a vector of symbols.
1797 else if (type
== XA_ATOM
)
1800 if (size
== sizeof (Atom
))
1801 return x_atom_to_symbol (display
, *((Atom
*) data
));
1804 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1806 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1807 Faset (v
, make_number (i
),
1808 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1813 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1814 If the number is > 16 bits, convert it to a cons of integers,
1815 16 bits in each half.
1817 else if (format
== 32 && size
== sizeof (int))
1818 return long_to_cons (((unsigned int *) data
) [0]);
1819 else if (format
== 16 && size
== sizeof (short))
1820 return make_number ((int) (((unsigned short *) data
) [0]));
1822 /* Convert any other kind of data to a vector of numbers, represented
1823 as above (as an integer, or a cons of two 16 bit integers.)
1825 else if (format
== 16)
1829 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1830 for (i
= 0; i
< size
/ 2; i
++)
1832 int j
= (int) ((unsigned short *) data
) [i
];
1833 Faset (v
, make_number (i
), make_number (j
));
1840 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1841 for (i
= 0; i
< size
/ 4; i
++)
1843 unsigned int j
= ((unsigned int *) data
) [i
];
1844 Faset (v
, make_number (i
), long_to_cons (j
));
1851 /* Use xfree, not XFree, to free the data obtained with this function. */
1854 lisp_data_to_selection_data (display
, obj
,
1855 data_ret
, type_ret
, size_ret
,
1856 format_ret
, nofree_ret
)
1859 unsigned char **data_ret
;
1861 unsigned int *size_ret
;
1865 Lisp_Object type
= Qnil
;
1866 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1870 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1874 if (CONSP (obj
) && NILP (XCDR (obj
)))
1878 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1879 { /* This is not the same as declining */
1885 else if (STRINGP (obj
))
1887 xassert (! STRING_MULTIBYTE (obj
));
1891 *size_ret
= SBYTES (obj
);
1892 *data_ret
= SDATA (obj
);
1895 else if (SYMBOLP (obj
))
1899 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1900 (*data_ret
) [sizeof (Atom
)] = 0;
1901 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1902 if (NILP (type
)) type
= QATOM
;
1904 else if (INTEGERP (obj
)
1905 && XINT (obj
) < 0xFFFF
1906 && XINT (obj
) > -0xFFFF)
1910 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1911 (*data_ret
) [sizeof (short)] = 0;
1912 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1913 if (NILP (type
)) type
= QINTEGER
;
1915 else if (INTEGERP (obj
)
1916 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1917 && (INTEGERP (XCDR (obj
))
1918 || (CONSP (XCDR (obj
))
1919 && INTEGERP (XCAR (XCDR (obj
)))))))
1923 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1924 (*data_ret
) [sizeof (long)] = 0;
1925 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1926 if (NILP (type
)) type
= QINTEGER
;
1928 else if (VECTORP (obj
))
1930 /* Lisp_Vectors may represent a set of ATOMs;
1931 a set of 16 or 32 bit INTEGERs;
1932 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1936 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1937 /* This vector is an ATOM set */
1939 if (NILP (type
)) type
= QATOM
;
1940 *size_ret
= XVECTOR (obj
)->size
;
1942 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1943 for (i
= 0; i
< *size_ret
; i
++)
1944 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1945 (*(Atom
**) data_ret
) [i
]
1946 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1948 Fsignal (Qerror
, /* Qselection_error */
1950 ("all elements of selection vector must have same type"),
1951 Fcons (obj
, Qnil
)));
1953 #if 0 /* #### MULTIPLE doesn't work yet */
1954 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1955 /* This vector is an ATOM_PAIR set */
1957 if (NILP (type
)) type
= QATOM_PAIR
;
1958 *size_ret
= XVECTOR (obj
)->size
;
1960 *data_ret
= (unsigned char *)
1961 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1962 for (i
= 0; i
< *size_ret
; i
++)
1963 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1965 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1966 if (XVECTOR (pair
)->size
!= 2)
1969 ("elements of the vector must be vectors of exactly two elements"),
1970 Fcons (pair
, Qnil
)));
1972 (*(Atom
**) data_ret
) [i
* 2]
1973 = symbol_to_x_atom (dpyinfo
, display
,
1974 XVECTOR (pair
)->contents
[0]);
1975 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1976 = symbol_to_x_atom (dpyinfo
, display
,
1977 XVECTOR (pair
)->contents
[1]);
1982 ("all elements of the vector must be of the same type"),
1983 Fcons (obj
, Qnil
)));
1988 /* This vector is an INTEGER set, or something like it */
1990 *size_ret
= XVECTOR (obj
)->size
;
1991 if (NILP (type
)) type
= QINTEGER
;
1993 for (i
= 0; i
< *size_ret
; i
++)
1994 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1996 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1997 Fsignal (Qerror
, /* Qselection_error */
1999 ("elements of selection vector must be integers or conses of integers"),
2000 Fcons (obj
, Qnil
)));
2002 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
2003 for (i
= 0; i
< *size_ret
; i
++)
2004 if (*format_ret
== 32)
2005 (*((unsigned long **) data_ret
)) [i
]
2006 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
2008 (*((unsigned short **) data_ret
)) [i
]
2009 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
2013 Fsignal (Qerror
, /* Qselection_error */
2014 Fcons (build_string ("unrecognised selection data"),
2015 Fcons (obj
, Qnil
)));
2017 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
2021 clean_local_selection_data (obj
)
2025 && INTEGERP (XCAR (obj
))
2026 && CONSP (XCDR (obj
))
2027 && INTEGERP (XCAR (XCDR (obj
)))
2028 && NILP (XCDR (XCDR (obj
))))
2029 obj
= Fcons (XCAR (obj
), XCDR (obj
));
2032 && INTEGERP (XCAR (obj
))
2033 && INTEGERP (XCDR (obj
)))
2035 if (XINT (XCAR (obj
)) == 0)
2037 if (XINT (XCAR (obj
)) == -1)
2038 return make_number (- XINT (XCDR (obj
)));
2043 int size
= XVECTOR (obj
)->size
;
2046 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
2047 copy
= Fmake_vector (make_number (size
), Qnil
);
2048 for (i
= 0; i
< size
; i
++)
2049 XVECTOR (copy
)->contents
[i
]
2050 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
2056 /* Called from XTread_socket to handle SelectionNotify events.
2057 If it's the selection we are waiting for, stop waiting
2058 by setting the car of reading_selection_reply to non-nil.
2059 We store t there if the reply is successful, lambda if not. */
2062 x_handle_selection_notify (event
)
2063 XSelectionEvent
*event
;
2065 if (event
->requestor
!= reading_selection_window
)
2067 if (event
->selection
!= reading_which_selection
)
2070 TRACE0 ("Received SelectionNotify");
2071 XSETCAR (reading_selection_reply
,
2072 (event
->property
!= 0 ? Qt
: Qlambda
));
2076 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2077 Sx_own_selection_internal
, 2, 2, 0,
2078 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2079 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2080 \(Those are literal upper-case symbol names, since that's what X expects.)
2081 VALUE is typically a string, or a cons of two markers, but may be
2082 anything that the functions on `selection-converter-alist' know about. */)
2083 (selection_name
, selection_value
)
2084 Lisp_Object selection_name
, selection_value
;
2087 CHECK_SYMBOL (selection_name
);
2088 if (NILP (selection_value
)) error ("selection-value may not be nil");
2089 x_own_selection (selection_name
, selection_value
);
2090 return selection_value
;
2094 /* Request the selection value from the owner. If we are the owner,
2095 simply return our selection value. If we are not the owner, this
2096 will block until all of the data has arrived. */
2098 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2099 Sx_get_selection_internal
, 2, 3, 0,
2100 doc
: /* Return text selected from some X window.
2101 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2102 \(Those are literal upper-case symbol names, since that's what X expects.)
2103 TYPE is the type of data desired, typically `STRING'.
2104 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2105 selections. If omitted, defaults to the time for the last event. */)
2106 (selection_symbol
, target_type
, time_stamp
)
2107 Lisp_Object selection_symbol
, target_type
, time_stamp
;
2109 Lisp_Object val
= Qnil
;
2110 struct gcpro gcpro1
, gcpro2
;
2111 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2113 CHECK_SYMBOL (selection_symbol
);
2115 #if 0 /* #### MULTIPLE doesn't work yet */
2116 if (CONSP (target_type
)
2117 && XCAR (target_type
) == QMULTIPLE
)
2119 CHECK_VECTOR (XCDR (target_type
));
2120 /* So we don't destructively modify this... */
2121 target_type
= copy_multiple_data (target_type
);
2125 CHECK_SYMBOL (target_type
);
2127 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2131 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2136 && SYMBOLP (XCAR (val
)))
2139 if (CONSP (val
) && NILP (XCDR (val
)))
2142 val
= clean_local_selection_data (val
);
2148 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2149 Sx_disown_selection_internal
, 1, 2, 0,
2150 doc
: /* If we own the selection SELECTION, disown it.
2151 Disowning it means there is no such selection. */)
2153 Lisp_Object selection
;
2157 Atom selection_atom
;
2158 struct selection_input_event event
;
2160 struct x_display_info
*dpyinfo
;
2161 struct frame
*sf
= SELECTED_FRAME ();
2164 if (! FRAME_X_P (sf
))
2167 display
= FRAME_X_DISPLAY (sf
);
2168 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2169 CHECK_SYMBOL (selection
);
2171 timestamp
= last_event_timestamp
;
2173 timestamp
= cons_to_long (time
);
2175 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2176 return Qnil
; /* Don't disown the selection when we're not the owner. */
2178 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2181 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2184 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2185 generated for a window which owns the selection when that window sets
2186 the selection owner to None. The NCD server does, the MIT Sun4 server
2187 doesn't. So we synthesize one; this means we might get two, but
2188 that's ok, because the second one won't have any effect. */
2189 SELECTION_EVENT_DISPLAY (&event
) = display
;
2190 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2191 SELECTION_EVENT_TIME (&event
) = timestamp
;
2192 x_handle_selection_clear ((struct input_event
*) &event
);
2197 /* Get rid of all the selections in buffer BUFFER.
2198 This is used when we kill a buffer. */
2201 x_disown_buffer_selections (buffer
)
2205 struct buffer
*buf
= XBUFFER (buffer
);
2207 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2209 Lisp_Object elt
, value
;
2212 if (CONSP (value
) && MARKERP (XCAR (value
))
2213 && XMARKER (XCAR (value
))->buffer
== buf
)
2214 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2218 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2220 doc
: /* Whether the current Emacs process owns the given X Selection.
2221 The arg should be the name of the selection in question, typically one of
2222 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2223 \(Those are literal upper-case symbol names, since that's what X expects.)
2224 For convenience, the symbol nil is the same as `PRIMARY',
2225 and t is the same as `SECONDARY'. */)
2227 Lisp_Object selection
;
2230 CHECK_SYMBOL (selection
);
2231 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2232 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2234 if (NILP (Fassq (selection
, Vselection_alist
)))
2239 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2241 doc
: /* Whether there is an owner for the given X Selection.
2242 The arg should be the name of the selection in question, typically one of
2243 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2244 \(Those are literal upper-case symbol names, since that's what X expects.)
2245 For convenience, the symbol nil is the same as `PRIMARY',
2246 and t is the same as `SECONDARY'. */)
2248 Lisp_Object selection
;
2253 struct frame
*sf
= SELECTED_FRAME ();
2255 /* It should be safe to call this before we have an X frame. */
2256 if (! FRAME_X_P (sf
))
2259 dpy
= FRAME_X_DISPLAY (sf
);
2260 CHECK_SYMBOL (selection
);
2261 if (!NILP (Fx_selection_owner_p (selection
)))
2263 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2264 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2265 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2269 owner
= XGetSelectionOwner (dpy
, atom
);
2271 return (owner
? Qt
: Qnil
);
2275 #ifdef CUT_BUFFER_SUPPORT
2277 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2279 initialize_cut_buffers (display
, window
)
2283 unsigned char *data
= (unsigned char *) "";
2285 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2286 PropModeAppend, data, 0)
2287 FROB (XA_CUT_BUFFER0
);
2288 FROB (XA_CUT_BUFFER1
);
2289 FROB (XA_CUT_BUFFER2
);
2290 FROB (XA_CUT_BUFFER3
);
2291 FROB (XA_CUT_BUFFER4
);
2292 FROB (XA_CUT_BUFFER5
);
2293 FROB (XA_CUT_BUFFER6
);
2294 FROB (XA_CUT_BUFFER7
);
2300 #define CHECK_CUT_BUFFER(symbol) \
2301 { CHECK_SYMBOL ((symbol)); \
2302 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2303 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2304 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2305 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2307 Fcons (build_string ("doesn't name a cut buffer"), \
2308 Fcons ((symbol), Qnil))); \
2311 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2312 Sx_get_cut_buffer_internal
, 1, 1, 0,
2313 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2319 unsigned char *data
;
2326 struct x_display_info
*dpyinfo
;
2327 struct frame
*sf
= SELECTED_FRAME ();
2331 if (! FRAME_X_P (sf
))
2334 display
= FRAME_X_DISPLAY (sf
);
2335 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2336 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2337 CHECK_CUT_BUFFER (buffer
);
2338 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2340 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2341 &type
, &format
, &size
, 0);
2342 if (!data
|| !format
)
2345 if (format
!= 8 || type
!= XA_STRING
)
2347 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2348 Fcons (x_atom_to_symbol (display
, type
),
2349 Fcons (make_number (format
), Qnil
))));
2351 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2352 /* Use xfree, not XFree, because x_get_window_property
2353 calls xmalloc itself. */
2359 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2360 Sx_store_cut_buffer_internal
, 2, 2, 0,
2361 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2363 Lisp_Object buffer
, string
;
2367 unsigned char *data
;
2369 int bytes_remaining
;
2372 struct frame
*sf
= SELECTED_FRAME ();
2376 if (! FRAME_X_P (sf
))
2379 display
= FRAME_X_DISPLAY (sf
);
2380 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2382 max_bytes
= SELECTION_QUANTUM (display
);
2383 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2384 max_bytes
= MAX_SELECTION_QUANTUM
;
2386 CHECK_CUT_BUFFER (buffer
);
2387 CHECK_STRING (string
);
2388 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2390 data
= (unsigned char *) SDATA (string
);
2391 bytes
= SBYTES (string
);
2392 bytes_remaining
= bytes
;
2394 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2396 initialize_cut_buffers (display
, window
);
2397 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2402 /* Don't mess up with an empty value. */
2403 if (!bytes_remaining
)
2404 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2405 PropModeReplace
, data
, 0);
2407 while (bytes_remaining
)
2409 int chunk
= (bytes_remaining
< max_bytes
2410 ? bytes_remaining
: max_bytes
);
2411 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2412 (bytes_remaining
== bytes
2417 bytes_remaining
-= chunk
;
2424 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2425 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2426 doc
: /* Rotate the values of the cut buffers by the given number of step.
2427 Positive means shift the values forward, negative means backward. */)
2434 struct frame
*sf
= SELECTED_FRAME ();
2438 if (! FRAME_X_P (sf
))
2441 display
= FRAME_X_DISPLAY (sf
);
2442 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2446 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2448 initialize_cut_buffers (display
, window
);
2449 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2452 props
[0] = XA_CUT_BUFFER0
;
2453 props
[1] = XA_CUT_BUFFER1
;
2454 props
[2] = XA_CUT_BUFFER2
;
2455 props
[3] = XA_CUT_BUFFER3
;
2456 props
[4] = XA_CUT_BUFFER4
;
2457 props
[5] = XA_CUT_BUFFER5
;
2458 props
[6] = XA_CUT_BUFFER6
;
2459 props
[7] = XA_CUT_BUFFER7
;
2461 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2468 /***********************************************************************
2469 Drag and drop support
2470 ***********************************************************************/
2471 /* Check that lisp values are of correct type for x_fill_property_data.
2472 That is, number, string or a cons with two numbers (low and high 16
2473 bit parts of a 32 bit number). */
2476 x_check_property_data (data
)
2482 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2484 Lisp_Object o
= XCAR (iter
);
2486 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2488 else if (CONSP (o
) &&
2489 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2496 /* Convert lisp values to a C array. Values may be a number, a string
2497 which is taken as an X atom name and converted to the atom value, or
2498 a cons containing the two 16 bit parts of a 32 bit number.
2500 DPY is the display use to look up X atoms.
2501 DATA is a Lisp list of values to be converted.
2502 RET is the C array that contains the converted values. It is assumed
2503 it is big enough to hol all values.
2504 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2505 be stored in RET. */
2508 x_fill_property_data (dpy
, data
, ret
, format
)
2515 CARD32
*d32
= (CARD32
*) ret
;
2516 CARD16
*d16
= (CARD16
*) ret
;
2517 CARD8
*d08
= (CARD8
*) ret
;
2520 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2522 Lisp_Object o
= XCAR (iter
);
2525 val
= (CARD32
) XFASTINT (o
);
2526 else if (FLOATP (o
))
2527 val
= (CARD32
) XFLOAT (o
);
2529 val
= (CARD32
) cons_to_long (o
);
2530 else if (STRINGP (o
))
2533 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2537 error ("Wrong type, must be string, number or cons");
2540 *d08
++ = (CARD8
) val
;
2541 else if (format
== 16)
2542 *d16
++ = (CARD16
) val
;
2548 /* Convert an array of C values to a Lisp list.
2549 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2550 DATA is a C array of values to be converted.
2551 TYPE is the type of the data. Only XA_ATOM is special, it converts
2552 each number in DATA to its corresponfing X atom as a symbol.
2553 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2555 SIZE is the number of elements in DATA.
2557 Also see comment for selection_data_to_lisp_data above. */
2560 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2562 unsigned char *data
;
2567 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2568 data
, size
*format
/8, type
, format
);
2571 /* Get the mouse position frame relative coordinates. */
2574 mouse_position_for_drop (f
, x
, y
)
2579 Window root
, dummy_window
;
2584 XQueryPointer (FRAME_X_DISPLAY (f
),
2585 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2587 /* The root window which contains the pointer. */
2590 /* Window pointer is on, not used */
2593 /* The position on that root window. */
2596 /* x/y in dummy_window coordinates, not used. */
2599 /* Modifier keys and pointer buttons, about which
2601 (unsigned int *) &dummy
);
2604 /* Absolute to relative. */
2605 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2606 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2611 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2612 Sx_get_atom_name
, 1, 2, 0,
2613 doc
: /* Return the X atom name for VALUE as a string.
2614 VALUE may be a number or a cons where the car is the upper 16 bits and
2615 the cdr is the lower 16 bits of a 32 bit value.
2616 Use the display for FRAME or the current frame if FRAME is not given or nil.
2618 If the value is 0 or the atom is not known, return the empty string. */)
2620 Lisp_Object value
, frame
;
2622 struct frame
*f
= check_x_frame (frame
);
2624 Lisp_Object ret
= Qnil
;
2626 Display
*dpy
= FRAME_X_DISPLAY (f
);
2629 if (INTEGERP (value
))
2630 atom
= (Atom
) XUINT (value
);
2631 else if (FLOATP (value
))
2632 atom
= (Atom
) XFLOAT (value
);
2633 else if (CONSP (value
))
2634 atom
= (Atom
) cons_to_long (value
);
2636 error ("Wrong type, value must be number or cons");
2639 count
= x_catch_errors (dpy
);
2641 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2643 if (! x_had_errors_p (dpy
))
2644 ret
= make_string (name
, strlen (name
));
2646 x_uncatch_errors (dpy
, count
);
2648 if (atom
&& name
) XFree (name
);
2649 if (NILP (ret
)) ret
= make_string ("", 0);
2656 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2657 TODO: Check if this client event really is a DND event? */
2660 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2662 XClientMessageEvent
*event
;
2663 struct x_display_info
*dpyinfo
;
2664 struct input_event
*bufp
;
2668 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2671 XSETFRAME (frame
, f
);
2673 vec
= Fmake_vector (make_number (4), Qnil
);
2674 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2675 event
->message_type
));
2676 AREF (vec
, 1) = frame
;
2677 AREF (vec
, 2) = make_number (event
->format
);
2678 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2680 event
->message_type
,
2684 mouse_position_for_drop (f
, &x
, &y
);
2685 bufp
->kind
= DRAG_N_DROP_EVENT
;
2686 bufp
->frame_or_window
= Fcons (frame
, vec
);
2687 bufp
->timestamp
= CurrentTime
;
2688 bufp
->x
= make_number (x
);
2689 bufp
->y
= make_number (y
);
2691 bufp
->modifiers
= 0;
2696 DEFUN ("x-send-client-message", Fx_send_client_event
,
2697 Sx_send_client_message
, 6, 6, 0,
2698 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2700 For DISPLAY, specify either a frame or a display name (a string).
2701 If DISPLAY is nil, that stands for the selected frame's display.
2702 DEST may be a number, in which case it is a Window id. The value 0 may
2703 be used to send to the root window of the DISPLAY.
2704 If DEST 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. That
2706 number is then used as a window id.
2707 If DEST is a frame the event is sent to the outer window of that frame.
2708 Nil means the currently selected frame.
2709 If DEST is the string "PointerWindow" the event is sent to the window that
2710 contains the pointer. If DEST is the string "InputFocus" the event is
2711 sent to the window that has the input focus.
2712 FROM is the frame sending the event. Use nil for currently selected frame.
2713 MESSAGE-TYPE is the name of an Atom as a string.
2714 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2715 bits. VALUES is a list of numbers, cons and/or strings containing the values
2716 to send. If a value is a string, it is converted to an Atom and the value of
2717 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2718 with the high 16 bits from the car and the lower 16 bit from the cdr.
2719 If more values than fits into the event is given, the excessive values
2721 (display
, dest
, from
, message_type
, format
, values
)
2722 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2724 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2729 struct frame
*f
= check_x_frame (from
);
2733 CHECK_STRING (message_type
);
2734 CHECK_NUMBER (format
);
2735 CHECK_CONS (values
);
2737 if (x_check_property_data (values
) == -1)
2738 error ("Bad data in VALUES, must be number, cons or string");
2740 event
.xclient
.type
= ClientMessage
;
2741 event
.xclient
.format
= XFASTINT (format
);
2743 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2744 && event
.xclient
.format
!= 32)
2745 error ("FORMAT must be one of 8, 16 or 32");
2747 if (FRAMEP (dest
) || NILP (dest
))
2749 struct frame
*fdest
= check_x_frame (dest
);
2750 wdest
= FRAME_OUTER_WINDOW (fdest
);
2752 else if (STRINGP (dest
))
2754 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2755 wdest
= PointerWindow
;
2756 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2759 error ("DEST as a string must be one of PointerWindow or InputFocus");
2761 else if (INTEGERP (dest
))
2762 wdest
= (Window
) XFASTINT (dest
);
2763 else if (FLOATP (dest
))
2764 wdest
= (Window
) XFLOAT (dest
);
2765 else if (CONSP (dest
))
2767 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2768 error ("Both car and cdr for DEST must be numbers");
2770 wdest
= (Window
) cons_to_long (dest
);
2773 error ("DEST must be a frame, nil, string, number or cons");
2775 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2776 to_root
= wdest
== dpyinfo
->root_window
;
2778 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2783 event
.xclient
.message_type
2784 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2785 event
.xclient
.display
= dpyinfo
->display
;
2787 /* Some clients (metacity for example) expects sending window to be here
2788 when sending to the root window. */
2789 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2791 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2792 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2793 event
.xclient
.format
);
2795 /* If event mask is 0 the event is sent to the client that created
2796 the destination window. But if we are sending to the root window,
2797 there is no such client. Then we set the event mask to 0xffff. The
2798 event then goes to clients selecting for events on the root window. */
2799 count
= x_catch_errors (dpyinfo
->display
);
2801 int propagate
= to_root
? False
: True
;
2802 unsigned mask
= to_root
? 0xffff : 0;
2803 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2804 XFlush (dpyinfo
->display
);
2806 x_uncatch_errors (dpyinfo
->display
, count
);
2816 defsubr (&Sx_get_selection_internal
);
2817 defsubr (&Sx_own_selection_internal
);
2818 defsubr (&Sx_disown_selection_internal
);
2819 defsubr (&Sx_selection_owner_p
);
2820 defsubr (&Sx_selection_exists_p
);
2822 #ifdef CUT_BUFFER_SUPPORT
2823 defsubr (&Sx_get_cut_buffer_internal
);
2824 defsubr (&Sx_store_cut_buffer_internal
);
2825 defsubr (&Sx_rotate_cut_buffers_internal
);
2828 defsubr (&Sx_get_atom_name
);
2829 defsubr (&Sx_send_client_message
);
2831 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2832 staticpro (&reading_selection_reply
);
2833 reading_selection_window
= 0;
2834 reading_which_selection
= 0;
2836 property_change_wait_list
= 0;
2837 prop_location_identifier
= 0;
2838 property_change_reply
= Fcons (Qnil
, Qnil
);
2839 staticpro (&property_change_reply
);
2841 Vselection_alist
= Qnil
;
2842 staticpro (&Vselection_alist
);
2844 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2845 doc
: /* An alist associating X Windows selection-types with functions.
2846 These functions are called to convert the selection, with three args:
2847 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2848 a desired type to which the selection should be converted;
2849 and the local selection value (whatever was given to `x-own-selection').
2851 The function should return the value to send to the X server
2852 \(typically a string). A return value of nil
2853 means that the conversion could not be done.
2854 A return value which is the symbol `NULL'
2855 means that a side-effect was executed,
2856 and there is no meaningful selection value. */);
2857 Vselection_converter_alist
= Qnil
;
2859 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions
,
2860 doc
: /* A list of functions to be called when Emacs loses an X selection.
2861 \(This happens when some other X client makes its own selection
2862 or when a Lisp program explicitly clears the selection.)
2863 The functions are called with one argument, the selection type
2864 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2865 Vx_lost_selection_functions
= Qnil
;
2867 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions
,
2868 doc
: /* A list of functions to be called when Emacs answers a selection request.
2869 The functions are called with four arguments:
2870 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2871 - the selection-type which Emacs was asked to convert the
2872 selection into before sending (for example, `STRING' or `LENGTH');
2873 - a flag indicating success or failure for responding to the request.
2874 We might have failed (and declined the request) for any number of reasons,
2875 including being asked for a selection that we no longer own, or being asked
2876 to convert into a type that we don't know about or that is inappropriate.
2877 This hook doesn't let you change the behavior of Emacs's selection replies,
2878 it merely informs you that they have happened. */);
2879 Vx_sent_selection_functions
= Qnil
;
2881 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2882 doc
: /* Coding system for communicating with other X clients.
2883 When sending or receiving text via cut_buffer, selection, and clipboard,
2884 the text is encoded or decoded by this coding system.
2885 The default value is `compound-text-with-extensions'. */);
2886 Vselection_coding_system
= intern ("compound-text-with-extensions");
2888 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2889 doc
: /* Coding system for the next communication with other X clients.
2890 Usually, `selection-coding-system' is used for communicating with
2891 other X clients. But, if this variable is set, it is used for the
2892 next communication only. After the communication, this variable is
2894 Vnext_selection_coding_system
= Qnil
;
2896 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2897 doc
: /* Number of milliseconds to wait for a selection reply.
2898 If the selection owner doesn't reply in this time, we give up.
2899 A value of 0 means wait as long as necessary. This is initialized from the
2900 \"*selectionTimeout\" resource. */);
2901 x_selection_timeout
= 0;
2903 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2904 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2905 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2906 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2907 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2908 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2909 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2910 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2911 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2912 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2913 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2914 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2915 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2916 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2917 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2918 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2919 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2920 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2921 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2922 staticpro (&Qcompound_text_with_extensions
);
2924 #ifdef CUT_BUFFER_SUPPORT
2925 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2926 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2927 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2928 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2929 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2930 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2931 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2932 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2935 Qforeign_selection
= intern ("foreign-selection");
2936 staticpro (&Qforeign_selection
);
2939 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2940 (do not change this comment) */