1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001
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 */
27 #include "xterm.h" /* for all of the X includes */
28 #include "dispextern.h" /* frame.h seems to want this */
29 #include "frame.h" /* Need this to get the X window of selected_frame */
30 #include "blockinput.h"
35 #include "composite.h"
39 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
40 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
42 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
43 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
44 static void x_decline_selection_request
P_ ((struct input_event
*));
45 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
46 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
47 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
48 static void x_reply_selection_request
P_ ((struct input_event
*, int,
49 unsigned char *, int, Atom
));
50 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
51 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
53 static void unexpect_property_change
P_ ((struct prop_location
*));
54 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
55 static void wait_for_property_change
P_ ((struct prop_location
*));
56 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
, Lisp_Object
));
57 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
58 unsigned char **, int *,
59 Atom
*, int *, unsigned long *, int));
60 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
61 Lisp_Object
, unsigned,
62 unsigned char **, int *,
63 Atom
*, int *, unsigned long *));
64 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
67 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
69 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
70 unsigned char **, Atom
*,
71 unsigned *, int *, int *));
72 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
73 static void initialize_cut_buffers
P_ ((Display
*, Window
));
76 /* Printing traces to stderr. */
78 #ifdef TRACE_SELECTION
80 fprintf (stderr, "%d: " fmt "\n", getpid ())
81 #define TRACE1(fmt, a0) \
82 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
83 #define TRACE2(fmt, a0, a1) \
84 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
86 #define TRACE0(fmt) (void) 0
87 #define TRACE1(fmt, a0) (void) 0
88 #define TRACE2(fmt, a0, a1) (void) 0
92 #define CUT_BUFFER_SUPPORT
94 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
95 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
98 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
99 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
101 Lisp_Object Qcompound_text_with_extensions
;
103 #ifdef CUT_BUFFER_SUPPORT
104 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
105 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
108 static Lisp_Object Vx_lost_selection_hooks
;
109 static Lisp_Object Vx_sent_selection_hooks
;
110 /* Coding system for communicating with other X clients via cutbuffer,
111 selection, and clipboard. */
112 static Lisp_Object Vselection_coding_system
;
114 /* Coding system for the next communicating with other X clients. */
115 static Lisp_Object Vnext_selection_coding_system
;
117 /* If this is a smaller number than the max-request-size of the display,
118 emacs will use INCR selection transfer when the selection is larger
119 than this. The max-request-size is usually around 64k, so if you want
120 emacs to use incremental selection transfers when the selection is
121 smaller than that, set this. I added this mostly for debugging the
122 incremental transfer stuff, but it might improve server performance. */
123 #define MAX_SELECTION_QUANTUM 0xFFFFFF
126 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
128 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
131 /* The timestamp of the last input event Emacs received from the X server. */
132 /* Defined in keyboard.c. */
133 extern unsigned long last_event_timestamp
;
135 /* This is an association list whose elements are of the form
136 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
137 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
138 SELECTION-VALUE is the value that emacs owns for that selection.
139 It may be any kind of Lisp object.
140 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
141 as a cons of two 16-bit numbers (making a 32 bit time.)
142 FRAME is the frame for which we made the selection.
143 If there is an entry in this alist, then it can be assumed that Emacs owns
145 The only (eq) parts of this list that are visible from Lisp are the
147 static Lisp_Object Vselection_alist
;
149 /* This is an alist whose CARs are selection-types (whose names are the same
150 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
151 call to convert the given Emacs selection value to a string representing
152 the given selection type. This is for Lisp-level extension of the emacs
153 selection handling. */
154 static Lisp_Object Vselection_converter_alist
;
156 /* If the selection owner takes too long to reply to a selection request,
157 we give up on it. This is in milliseconds (0 = no timeout.) */
158 static EMACS_INT x_selection_timeout
;
160 /* Utility functions */
162 static void lisp_data_to_selection_data ();
163 static Lisp_Object
selection_data_to_lisp_data ();
164 static Lisp_Object
x_get_window_property_as_lisp_data ();
166 /* This converts a Lisp symbol to a server Atom, avoiding a server
167 roundtrip whenever possible. */
170 symbol_to_x_atom (dpyinfo
, display
, sym
)
171 struct x_display_info
*dpyinfo
;
176 if (NILP (sym
)) return 0;
177 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
178 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
179 if (EQ (sym
, QSTRING
)) return XA_STRING
;
180 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
181 if (EQ (sym
, QATOM
)) return XA_ATOM
;
182 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
183 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
184 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
185 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
186 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
187 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
188 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
189 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
190 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
191 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
192 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
193 #ifdef CUT_BUFFER_SUPPORT
194 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
195 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
196 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
197 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
198 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
199 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
200 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
201 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
203 if (!SYMBOLP (sym
)) abort ();
205 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
207 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
213 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
214 and calls to intern whenever possible. */
217 x_atom_to_symbol (dpy
, atom
)
221 struct x_display_info
*dpyinfo
;
240 #ifdef CUT_BUFFER_SUPPORT
260 dpyinfo
= x_display_info_for_display (dpy
);
261 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
263 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
265 if (atom
== dpyinfo
->Xatom_TEXT
)
267 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
268 return QCOMPOUND_TEXT
;
269 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
271 if (atom
== dpyinfo
->Xatom_DELETE
)
273 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
275 if (atom
== dpyinfo
->Xatom_INCR
)
277 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
279 if (atom
== dpyinfo
->Xatom_TARGETS
)
281 if (atom
== dpyinfo
->Xatom_NULL
)
285 str
= XGetAtomName (dpy
, atom
);
287 TRACE1 ("XGetAtomName --> %s", str
);
288 if (! str
) return Qnil
;
291 /* This was allocated by Xlib, so use XFree. */
297 /* Do protocol to assert ourself as a selection owner.
298 Update the Vselection_alist so that we can reply to later requests for
302 x_own_selection (selection_name
, selection_value
)
303 Lisp_Object selection_name
, selection_value
;
305 struct frame
*sf
= SELECTED_FRAME ();
306 Window selecting_window
= FRAME_X_WINDOW (sf
);
307 Display
*display
= FRAME_X_DISPLAY (sf
);
308 Time time
= last_event_timestamp
;
310 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
313 CHECK_SYMBOL (selection_name
);
314 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
317 count
= x_catch_errors (display
);
318 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
319 x_check_errors (display
, "Can't set selection: %s");
320 x_uncatch_errors (display
, count
);
323 /* Now update the local cache */
325 Lisp_Object selection_time
;
326 Lisp_Object selection_data
;
327 Lisp_Object prev_value
;
329 selection_time
= long_to_cons ((unsigned long) time
);
330 selection_data
= Fcons (selection_name
,
331 Fcons (selection_value
,
332 Fcons (selection_time
,
333 Fcons (selected_frame
, Qnil
))));
334 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
336 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
338 /* If we already owned the selection, remove the old selection data.
339 Perhaps we should destructively modify it instead.
340 Don't use Fdelq as that may QUIT. */
341 if (!NILP (prev_value
))
343 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
344 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
345 if (EQ (prev_value
, Fcar (XCDR (rest
))))
347 XSETCDR (rest
, Fcdr (XCDR (rest
)));
354 /* Given a selection-name and desired type, look up our local copy of
355 the selection value and convert it to the type.
356 The value is nil or a string.
357 This function is used both for remote requests (LOCAL_REQUEST is zero)
358 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
360 This calls random Lisp code, and may signal or gc. */
363 x_get_local_selection (selection_symbol
, target_type
, local_request
)
364 Lisp_Object selection_symbol
, target_type
;
367 Lisp_Object local_value
;
368 Lisp_Object handler_fn
, value
, type
, check
;
371 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
373 if (NILP (local_value
)) return Qnil
;
375 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
376 if (EQ (target_type
, QTIMESTAMP
))
379 value
= XCAR (XCDR (XCDR (local_value
)));
382 else if (EQ (target_type
, QDELETE
))
385 Fx_disown_selection_internal
387 XCAR (XCDR (XCDR (local_value
))));
392 #if 0 /* #### MULTIPLE doesn't work yet */
393 else if (CONSP (target_type
)
394 && XCAR (target_type
) == QMULTIPLE
)
399 pairs
= XCDR (target_type
);
400 size
= XVECTOR (pairs
)->size
;
401 /* If the target is MULTIPLE, then target_type looks like
402 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
403 We modify the second element of each pair in the vector and
404 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
406 for (i
= 0; i
< size
; i
++)
409 pair
= XVECTOR (pairs
)->contents
[i
];
410 XVECTOR (pair
)->contents
[1]
411 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
412 XVECTOR (pair
)->contents
[1],
420 /* Don't allow a quit within the converter.
421 When the user types C-g, he would be surprised
422 if by luck it came during a converter. */
423 count
= SPECPDL_INDEX ();
424 specbind (Qinhibit_quit
, Qt
);
426 CHECK_SYMBOL (target_type
);
427 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
428 if (!NILP (handler_fn
))
429 value
= call3 (handler_fn
,
430 selection_symbol
, (local_request
? Qnil
: target_type
),
431 XCAR (XCDR (local_value
)));
434 unbind_to (count
, Qnil
);
437 /* Make sure this value is of a type that we could transmit
438 to another X client. */
442 && SYMBOLP (XCAR (value
)))
444 check
= XCDR (value
);
452 /* Check for a value that cons_to_long could handle. */
453 else if (CONSP (check
)
454 && INTEGERP (XCAR (check
))
455 && (INTEGERP (XCDR (check
))
457 (CONSP (XCDR (check
))
458 && INTEGERP (XCAR (XCDR (check
)))
459 && NILP (XCDR (XCDR (check
))))))
464 Fcons (build_string ("invalid data returned by selection-conversion function"),
465 Fcons (handler_fn
, Fcons (value
, Qnil
))));
468 /* Subroutines of x_reply_selection_request. */
470 /* Send a SelectionNotify event to the requestor with property=None,
471 meaning we were unable to do what they wanted. */
474 x_decline_selection_request (event
)
475 struct input_event
*event
;
477 XSelectionEvent reply
;
480 reply
.type
= SelectionNotify
;
481 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
482 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
483 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
484 reply
.time
= SELECTION_EVENT_TIME (event
);
485 reply
.target
= SELECTION_EVENT_TARGET (event
);
486 reply
.property
= None
;
488 /* The reason for the error may be that the receiver has
489 died in the meantime. Handle that case. */
491 count
= x_catch_errors (reply
.display
);
492 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
493 XFlush (reply
.display
);
494 x_uncatch_errors (reply
.display
, count
);
498 /* This is the selection request currently being processed.
499 It is set to zero when the request is fully processed. */
500 static struct input_event
*x_selection_current_request
;
502 /* Display info in x_selection_request. */
504 static struct x_display_info
*selection_request_dpyinfo
;
506 /* Used as an unwind-protect clause so that, if a selection-converter signals
507 an error, we tell the requester that we were unable to do what they wanted
508 before we throw to top-level or go into the debugger or whatever. */
511 x_selection_request_lisp_error (ignore
)
514 if (x_selection_current_request
!= 0
515 && selection_request_dpyinfo
->display
)
516 x_decline_selection_request (x_selection_current_request
);
521 /* This stuff is so that INCR selections are reentrant (that is, so we can
522 be servicing multiple INCR selection requests simultaneously.) I haven't
523 actually tested that yet. */
525 /* Keep a list of the property changes that are awaited. */
535 struct prop_location
*next
;
538 static struct prop_location
*expect_property_change ();
539 static void wait_for_property_change ();
540 static void unexpect_property_change ();
541 static int waiting_for_other_props_on_window ();
543 static int prop_location_identifier
;
545 static Lisp_Object property_change_reply
;
547 static struct prop_location
*property_change_reply_object
;
549 static struct prop_location
*property_change_wait_list
;
552 queue_selection_requests_unwind (frame
)
555 FRAME_PTR f
= XFRAME (frame
);
558 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
562 /* Return some frame whose display info is DPYINFO.
563 Return nil if there is none. */
566 some_frame_on_display (dpyinfo
)
567 struct x_display_info
*dpyinfo
;
569 Lisp_Object list
, frame
;
571 FOR_EACH_FRAME (list
, frame
)
573 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
580 /* Send the reply to a selection request event EVENT.
581 TYPE is the type of selection data requested.
582 DATA and SIZE describe the data to send, already converted.
583 FORMAT is the unit-size (in bits) of the data to be transmitted. */
586 x_reply_selection_request (event
, format
, data
, size
, type
)
587 struct input_event
*event
;
592 XSelectionEvent reply
;
593 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
594 Window window
= SELECTION_EVENT_REQUESTOR (event
);
596 int format_bytes
= format
/8;
597 int max_bytes
= SELECTION_QUANTUM (display
);
598 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
601 if (max_bytes
> MAX_SELECTION_QUANTUM
)
602 max_bytes
= MAX_SELECTION_QUANTUM
;
604 reply
.type
= SelectionNotify
;
605 reply
.display
= display
;
606 reply
.requestor
= window
;
607 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
608 reply
.time
= SELECTION_EVENT_TIME (event
);
609 reply
.target
= SELECTION_EVENT_TARGET (event
);
610 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
611 if (reply
.property
== None
)
612 reply
.property
= reply
.target
;
614 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
616 count
= x_catch_errors (display
);
618 /* Store the data on the requested property.
619 If the selection is large, only store the first N bytes of it.
621 bytes_remaining
= size
* format_bytes
;
622 if (bytes_remaining
<= max_bytes
)
624 /* Send all the data at once, with minimal handshaking. */
625 TRACE1 ("Sending all %d bytes", bytes_remaining
);
626 XChangeProperty (display
, window
, reply
.property
, type
, format
,
627 PropModeReplace
, data
, size
);
628 /* At this point, the selection was successfully stored; ack it. */
629 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
633 /* Send an INCR selection. */
634 struct prop_location
*wait_object
;
638 frame
= some_frame_on_display (dpyinfo
);
640 /* If the display no longer has frames, we can't expect
641 to get many more selection requests from it, so don't
642 bother trying to queue them. */
645 x_start_queuing_selection_requests (display
);
647 record_unwind_protect (queue_selection_requests_unwind
,
651 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
652 error ("Attempt to transfer an INCR to ourself!");
654 TRACE2 ("Start sending %d bytes incrementally (%s)",
655 bytes_remaining
, XGetAtomName (display
, reply
.property
));
656 wait_object
= expect_property_change (display
, window
, reply
.property
,
659 TRACE1 ("Set %s to number of bytes to send",
660 XGetAtomName (display
, reply
.property
));
661 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
663 (unsigned char *) &bytes_remaining
, 1);
664 XSelectInput (display
, window
, PropertyChangeMask
);
666 /* Tell 'em the INCR data is there... */
667 TRACE0 ("Send SelectionNotify event");
668 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
671 had_errors
= x_had_errors_p (display
);
674 /* First, wait for the requester to ack by deleting the property.
675 This can run random lisp code (process handlers) or signal. */
678 TRACE1 ("Waiting for ACK (deletion of %s)",
679 XGetAtomName (display
, reply
.property
));
680 wait_for_property_change (wait_object
);
684 while (bytes_remaining
)
686 int i
= ((bytes_remaining
< max_bytes
)
693 = expect_property_change (display
, window
, reply
.property
,
696 TRACE1 ("Sending increment of %d bytes", i
);
697 TRACE1 ("Set %s to increment data",
698 XGetAtomName (display
, reply
.property
));
700 /* Append the next chunk of data to the property. */
701 XChangeProperty (display
, window
, reply
.property
, type
, format
,
702 PropModeAppend
, data
, i
/ format_bytes
);
703 bytes_remaining
-= i
;
706 had_errors
= x_had_errors_p (display
);
712 /* Now wait for the requester to ack this chunk by deleting the
713 property. This can run random lisp code or signal. */
714 TRACE1 ("Waiting for increment ACK (deletion of %s)",
715 XGetAtomName (display
, reply
.property
));
716 wait_for_property_change (wait_object
);
719 /* Now write a zero-length chunk to the property to tell the
720 requester that we're done. */
722 if (! waiting_for_other_props_on_window (display
, window
))
723 XSelectInput (display
, window
, 0L);
725 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
726 XGetAtomName (display
, reply
.property
));
727 XChangeProperty (display
, window
, reply
.property
, type
, format
,
728 PropModeReplace
, data
, 0);
729 TRACE0 ("Done sending incrementally");
732 /* rms, 2003-01-03: I think I have fixed this bug. */
733 /* The window we're communicating with may have been deleted
734 in the meantime (that's a real situation from a bug report).
735 In this case, there may be events in the event queue still
736 refering to the deleted window, and we'll get a BadWindow error
737 in XTread_socket when processing the events. I don't have
738 an idea how to fix that. gerd, 2001-01-98. */
740 x_uncatch_errors (display
, count
);
744 /* Handle a SelectionRequest event EVENT.
745 This is called from keyboard.c when such an event is found in the queue. */
748 x_handle_selection_request (event
)
749 struct input_event
*event
;
751 struct gcpro gcpro1
, gcpro2
, gcpro3
;
752 Lisp_Object local_selection_data
;
753 Lisp_Object selection_symbol
;
754 Lisp_Object target_symbol
;
755 Lisp_Object converted_selection
;
756 Time local_selection_time
;
757 Lisp_Object successful_p
;
759 struct x_display_info
*dpyinfo
760 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
762 local_selection_data
= Qnil
;
763 target_symbol
= Qnil
;
764 converted_selection
= Qnil
;
767 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
769 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
770 SELECTION_EVENT_SELECTION (event
));
772 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
774 if (NILP (local_selection_data
))
776 /* Someone asked for the selection, but we don't have it any more.
778 x_decline_selection_request (event
);
782 local_selection_time
= (Time
)
783 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
785 if (SELECTION_EVENT_TIME (event
) != CurrentTime
786 && local_selection_time
> SELECTION_EVENT_TIME (event
))
788 /* Someone asked for the selection, and we have one, but not the one
791 x_decline_selection_request (event
);
795 x_selection_current_request
= event
;
796 count
= SPECPDL_INDEX ();
797 selection_request_dpyinfo
= dpyinfo
;
798 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
800 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
801 SELECTION_EVENT_TARGET (event
));
803 #if 0 /* #### MULTIPLE doesn't work yet */
804 if (EQ (target_symbol
, QMULTIPLE
))
805 target_symbol
= fetch_multiple_target (event
);
808 /* Convert lisp objects back into binary data */
811 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
813 if (! NILP (converted_selection
))
821 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
823 &data
, &type
, &size
, &format
, &nofree
);
825 x_reply_selection_request (event
, format
, data
, size
, type
);
828 /* Indicate we have successfully processed this event. */
829 x_selection_current_request
= 0;
831 /* Use xfree, not XFree, because lisp_data_to_selection_data
832 calls xmalloc itself. */
836 unbind_to (count
, Qnil
);
842 /* Let random lisp code notice that the selection has been asked for. */
845 rest
= Vx_sent_selection_hooks
;
846 if (!EQ (rest
, Qunbound
))
847 for (; CONSP (rest
); rest
= Fcdr (rest
))
848 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
852 /* Handle a SelectionClear event EVENT, which indicates that some
853 client cleared out our previously asserted selection.
854 This is called from keyboard.c when such an event is found in the queue. */
857 x_handle_selection_clear (event
)
858 struct input_event
*event
;
860 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
861 Atom selection
= SELECTION_EVENT_SELECTION (event
);
862 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
864 Lisp_Object selection_symbol
, local_selection_data
;
865 Time local_selection_time
;
866 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
867 struct x_display_info
*t_dpyinfo
;
869 /* If the new selection owner is also Emacs,
870 don't clear the new selection. */
872 /* Check each display on the same terminal,
873 to see if this Emacs job now owns the selection
874 through that display. */
875 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
876 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
879 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
880 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
888 selection_symbol
= x_atom_to_symbol (display
, selection
);
890 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
892 /* Well, we already believe that we don't own it, so that's just fine. */
893 if (NILP (local_selection_data
)) return;
895 local_selection_time
= (Time
)
896 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
898 /* This SelectionClear is for a selection that we no longer own, so we can
899 disregard it. (That is, we have reasserted the selection since this
900 request was generated.) */
902 if (changed_owner_time
!= CurrentTime
903 && local_selection_time
> changed_owner_time
)
906 /* Otherwise, we're really honest and truly being told to drop it.
907 Don't use Fdelq as that may QUIT;. */
909 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
910 Vselection_alist
= Fcdr (Vselection_alist
);
914 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
915 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
917 XSETCDR (rest
, Fcdr (XCDR (rest
)));
922 /* Let random lisp code notice that the selection has been stolen. */
926 rest
= Vx_lost_selection_hooks
;
927 if (!EQ (rest
, Qunbound
))
929 for (; CONSP (rest
); rest
= Fcdr (rest
))
930 call1 (Fcar (rest
), selection_symbol
);
931 prepare_menu_bars ();
932 redisplay_preserve_echo_area (20);
937 /* Clear all selections that were made from frame F.
938 We do this when about to delete a frame. */
941 x_clear_frame_selections (f
)
947 XSETFRAME (frame
, f
);
949 /* Otherwise, we're really honest and truly being told to drop it.
950 Don't use Fdelq as that may QUIT;. */
952 /* Delete elements from the beginning of Vselection_alist. */
953 while (!NILP (Vselection_alist
)
954 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
956 /* Let random Lisp code notice that the selection has been stolen. */
957 Lisp_Object hooks
, selection_symbol
;
959 hooks
= Vx_lost_selection_hooks
;
960 selection_symbol
= Fcar (Fcar (Vselection_alist
));
962 if (!EQ (hooks
, Qunbound
))
964 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
965 call1 (Fcar (hooks
), selection_symbol
);
966 #if 0 /* This can crash when deleting a frame
967 from x_connection_closed. Anyway, it seems unnecessary;
968 something else should cause a redisplay. */
969 redisplay_preserve_echo_area (21);
973 Vselection_alist
= Fcdr (Vselection_alist
);
976 /* Delete elements after the beginning of Vselection_alist. */
977 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
978 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
980 /* Let random Lisp code notice that the selection has been stolen. */
981 Lisp_Object hooks
, selection_symbol
;
983 hooks
= Vx_lost_selection_hooks
;
984 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
986 if (!EQ (hooks
, Qunbound
))
988 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
989 call1 (Fcar (hooks
), selection_symbol
);
990 #if 0 /* See above */
991 redisplay_preserve_echo_area (22);
994 XSETCDR (rest
, Fcdr (XCDR (rest
)));
999 /* Nonzero if any properties for DISPLAY and WINDOW
1000 are on the list of what we are waiting for. */
1003 waiting_for_other_props_on_window (display
, window
)
1007 struct prop_location
*rest
= property_change_wait_list
;
1009 if (rest
->display
== display
&& rest
->window
== window
)
1016 /* Add an entry to the list of property changes we are waiting for.
1017 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1018 The return value is a number that uniquely identifies
1019 this awaited property change. */
1021 static struct prop_location
*
1022 expect_property_change (display
, window
, property
, state
)
1028 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1029 pl
->identifier
= ++prop_location_identifier
;
1030 pl
->display
= display
;
1031 pl
->window
= window
;
1032 pl
->property
= property
;
1033 pl
->desired_state
= state
;
1034 pl
->next
= property_change_wait_list
;
1036 property_change_wait_list
= pl
;
1040 /* Delete an entry from the list of property changes we are waiting for.
1041 IDENTIFIER is the number that uniquely identifies the entry. */
1044 unexpect_property_change (location
)
1045 struct prop_location
*location
;
1047 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1050 if (rest
== location
)
1053 prev
->next
= rest
->next
;
1055 property_change_wait_list
= rest
->next
;
1064 /* Remove the property change expectation element for IDENTIFIER. */
1067 wait_for_property_change_unwind (identifierval
)
1068 Lisp_Object identifierval
;
1070 unexpect_property_change ((struct prop_location
*)
1071 (XFASTINT (XCAR (identifierval
)) << 16
1072 | XFASTINT (XCDR (identifierval
))));
1076 /* Actually wait for a property change.
1077 IDENTIFIER should be the value that expect_property_change returned. */
1080 wait_for_property_change (location
)
1081 struct prop_location
*location
;
1084 int count
= SPECPDL_INDEX ();
1087 tem
= Fcons (Qnil
, Qnil
);
1088 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1089 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1091 /* Make sure to do unexpect_property_change if we quit or err. */
1092 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1094 XSETCAR (property_change_reply
, Qnil
);
1096 property_change_reply_object
= location
;
1097 /* If the event we are waiting for arrives beyond here, it will set
1098 property_change_reply, because property_change_reply_object says so. */
1099 if (! location
->arrived
)
1101 secs
= x_selection_timeout
/ 1000;
1102 usecs
= (x_selection_timeout
% 1000) * 1000;
1103 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1104 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1106 if (NILP (XCAR (property_change_reply
)))
1108 TRACE0 (" Timed out");
1109 error ("Timed out waiting for property-notify event");
1113 unbind_to (count
, Qnil
);
1116 /* Called from XTread_socket in response to a PropertyNotify event. */
1119 x_handle_property_notify (event
)
1120 XPropertyEvent
*event
;
1122 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1126 if (rest
->property
== event
->atom
1127 && rest
->window
== event
->window
1128 && rest
->display
== event
->display
1129 && rest
->desired_state
== event
->state
)
1131 TRACE2 ("Expected %s of property %s",
1132 (event
->state
== PropertyDelete
? "deletion" : "change"),
1133 XGetAtomName (event
->display
, event
->atom
));
1137 /* If this is the one wait_for_property_change is waiting for,
1138 tell it to wake up. */
1139 if (rest
== property_change_reply_object
)
1140 XSETCAR (property_change_reply
, Qt
);
1143 prev
->next
= rest
->next
;
1145 property_change_wait_list
= rest
->next
;
1157 #if 0 /* #### MULTIPLE doesn't work yet */
1160 fetch_multiple_target (event
)
1161 XSelectionRequestEvent
*event
;
1163 Display
*display
= event
->display
;
1164 Window window
= event
->requestor
;
1165 Atom target
= event
->target
;
1166 Atom selection_atom
= event
->selection
;
1171 x_get_window_property_as_lisp_data (display
, window
, target
,
1172 QMULTIPLE
, selection_atom
));
1176 copy_multiple_data (obj
)
1183 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1186 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1187 for (i
= 0; i
< size
; i
++)
1189 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1190 CHECK_VECTOR (vec2
);
1191 if (XVECTOR (vec2
)->size
!= 2)
1192 /* ??? Confusing error message */
1193 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1194 Fcons (vec2
, Qnil
)));
1195 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1196 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1197 = XVECTOR (vec2
)->contents
[0];
1198 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1199 = XVECTOR (vec2
)->contents
[1];
1207 /* Variables for communication with x_handle_selection_notify. */
1208 static Atom reading_which_selection
;
1209 static Lisp_Object reading_selection_reply
;
1210 static Window reading_selection_window
;
1212 /* Do protocol to read selection-data from the server.
1213 Converts this to Lisp data and returns it. */
1216 x_get_foreign_selection (selection_symbol
, target_type
)
1217 Lisp_Object selection_symbol
, target_type
;
1219 struct frame
*sf
= SELECTED_FRAME ();
1220 Window requestor_window
= FRAME_X_WINDOW (sf
);
1221 Display
*display
= FRAME_X_DISPLAY (sf
);
1222 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1223 Time requestor_time
= last_event_timestamp
;
1224 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1225 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1231 if (CONSP (target_type
))
1232 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1234 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1238 count
= x_catch_errors (display
);
1240 TRACE2 ("Get selection %s, type %s",
1241 XGetAtomName (display
, type_atom
),
1242 XGetAtomName (display
, target_property
));
1244 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1245 requestor_window
, requestor_time
);
1248 /* Prepare to block until the reply has been read. */
1249 reading_selection_window
= requestor_window
;
1250 reading_which_selection
= selection_atom
;
1251 XSETCAR (reading_selection_reply
, Qnil
);
1253 frame
= some_frame_on_display (dpyinfo
);
1255 /* If the display no longer has frames, we can't expect
1256 to get many more selection requests from it, so don't
1257 bother trying to queue them. */
1260 x_start_queuing_selection_requests (display
);
1262 record_unwind_protect (queue_selection_requests_unwind
,
1267 /* This allows quits. Also, don't wait forever. */
1268 secs
= x_selection_timeout
/ 1000;
1269 usecs
= (x_selection_timeout
% 1000) * 1000;
1270 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1271 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1272 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1275 x_check_errors (display
, "Cannot get selection: %s");
1276 x_uncatch_errors (display
, count
);
1279 if (NILP (XCAR (reading_selection_reply
)))
1280 error ("Timed out waiting for reply from selection owner");
1281 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1282 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1284 /* Otherwise, the selection is waiting for us on the requested property. */
1286 x_get_window_property_as_lisp_data (display
, requestor_window
,
1287 target_property
, target_type
,
1291 /* Subroutines of x_get_window_property_as_lisp_data */
1293 /* Use xfree, not XFree, to free the data obtained with this function. */
1296 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1297 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1302 unsigned char **data_ret
;
1304 Atom
*actual_type_ret
;
1305 int *actual_format_ret
;
1306 unsigned long *actual_size_ret
;
1310 unsigned long bytes_remaining
;
1312 unsigned char *tmp_data
= 0;
1314 int buffer_size
= SELECTION_QUANTUM (display
);
1316 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1317 buffer_size
= MAX_SELECTION_QUANTUM
;
1321 /* First probe the thing to find out how big it is. */
1322 result
= XGetWindowProperty (display
, window
, property
,
1323 0L, 0L, False
, AnyPropertyType
,
1324 actual_type_ret
, actual_format_ret
,
1326 &bytes_remaining
, &tmp_data
);
1327 if (result
!= Success
)
1335 /* This was allocated by Xlib, so use XFree. */
1336 XFree ((char *) tmp_data
);
1338 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1344 total_size
= bytes_remaining
+ 1;
1345 *data_ret
= (unsigned char *) xmalloc (total_size
);
1347 /* Now read, until we've gotten it all. */
1348 while (bytes_remaining
)
1350 #ifdef TRACE_SELECTION
1351 int last
= bytes_remaining
;
1354 = XGetWindowProperty (display
, window
, property
,
1355 (long)offset
/4, (long)buffer_size
/4,
1358 actual_type_ret
, actual_format_ret
,
1359 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1361 TRACE2 ("Read %ld bytes from property %s",
1362 last
- bytes_remaining
,
1363 XGetAtomName (display
, property
));
1365 /* If this doesn't return Success at this point, it means that
1366 some clod deleted the selection while we were in the midst of
1367 reading it. Deal with that, I guess.... */
1368 if (result
!= Success
)
1370 *actual_size_ret
*= *actual_format_ret
/ 8;
1371 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1372 offset
+= *actual_size_ret
;
1374 /* This was allocated by Xlib, so use XFree. */
1375 XFree ((char *) tmp_data
);
1380 *bytes_ret
= offset
;
1383 /* Use xfree, not XFree, to free the data obtained with this function. */
1386 receive_incremental_selection (display
, window
, property
, target_type
,
1387 min_size_bytes
, data_ret
, size_bytes_ret
,
1388 type_ret
, format_ret
, size_ret
)
1392 Lisp_Object target_type
; /* for error messages only */
1393 unsigned int min_size_bytes
;
1394 unsigned char **data_ret
;
1395 int *size_bytes_ret
;
1397 unsigned long *size_ret
;
1401 struct prop_location
*wait_object
;
1402 *size_bytes_ret
= min_size_bytes
;
1403 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1405 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1407 /* At this point, we have read an INCR property.
1408 Delete the property to ack it.
1409 (But first, prepare to receive the next event in this handshake.)
1411 Now, we must loop, waiting for the sending window to put a value on
1412 that property, then reading the property, then deleting it to ack.
1413 We are done when the sender places a property of length 0.
1416 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1417 TRACE1 (" Delete property %s",
1418 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1419 XDeleteProperty (display
, window
, property
);
1420 TRACE1 (" Expect new value of property %s",
1421 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1422 wait_object
= expect_property_change (display
, window
, property
,
1429 unsigned char *tmp_data
;
1432 TRACE0 (" Wait for property change");
1433 wait_for_property_change (wait_object
);
1435 /* expect it again immediately, because x_get_window_property may
1436 .. no it won't, I don't get it.
1437 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1438 TRACE0 (" Get property value");
1439 x_get_window_property (display
, window
, property
,
1440 &tmp_data
, &tmp_size_bytes
,
1441 type_ret
, format_ret
, size_ret
, 1);
1443 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1445 if (tmp_size_bytes
== 0) /* we're done */
1447 TRACE0 ("Done reading incrementally");
1449 if (! waiting_for_other_props_on_window (display
, window
))
1450 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1451 unexpect_property_change (wait_object
);
1452 /* Use xfree, not XFree, because x_get_window_property
1453 calls xmalloc itself. */
1454 if (tmp_data
) xfree (tmp_data
);
1459 TRACE1 (" ACK by deleting property %s",
1460 XGetAtomName (display
, property
));
1461 XDeleteProperty (display
, window
, property
);
1462 wait_object
= expect_property_change (display
, window
, property
,
1467 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1469 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1470 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1473 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1474 offset
+= tmp_size_bytes
;
1476 /* Use xfree, not XFree, because x_get_window_property
1477 calls xmalloc itself. */
1483 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1484 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1485 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1488 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1493 Lisp_Object target_type
; /* for error messages only */
1494 Atom selection_atom
; /* for error messages only */
1498 unsigned long actual_size
;
1499 unsigned char *data
= 0;
1502 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1504 TRACE0 ("Reading selection data");
1506 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1507 &actual_type
, &actual_format
, &actual_size
, 1);
1510 int there_is_a_selection_owner
;
1512 there_is_a_selection_owner
1513 = XGetSelectionOwner (display
, selection_atom
);
1516 there_is_a_selection_owner
1517 ? Fcons (build_string ("selection owner couldn't convert"),
1519 ? Fcons (target_type
,
1520 Fcons (x_atom_to_symbol (display
,
1523 : Fcons (target_type
, Qnil
))
1524 : Fcons (build_string ("no selection"),
1525 Fcons (x_atom_to_symbol (display
,
1530 if (actual_type
== dpyinfo
->Xatom_INCR
)
1532 /* That wasn't really the data, just the beginning. */
1534 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1536 /* Use xfree, not XFree, because x_get_window_property
1537 calls xmalloc itself. */
1538 xfree ((char *) data
);
1540 receive_incremental_selection (display
, window
, property
, target_type
,
1541 min_size_bytes
, &data
, &bytes
,
1542 &actual_type
, &actual_format
,
1547 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1548 XDeleteProperty (display
, window
, property
);
1552 /* It's been read. Now convert it to a lisp object in some semi-rational
1554 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1555 actual_type
, actual_format
);
1557 /* Use xfree, not XFree, because x_get_window_property
1558 calls xmalloc itself. */
1559 xfree ((char *) data
);
1563 /* These functions convert from the selection data read from the server into
1564 something that we can use from Lisp, and vice versa.
1566 Type: Format: Size: Lisp Type:
1567 ----- ------- ----- -----------
1570 ATOM 32 > 1 Vector of Symbols
1572 * 16 > 1 Vector of Integers
1573 * 32 1 if <=16 bits: Integer
1574 if > 16 bits: Cons of top16, bot16
1575 * 32 > 1 Vector of the above
1577 When converting a Lisp number to C, it is assumed to be of format 16 if
1578 it is an integer, and of format 32 if it is a cons of two integers.
1580 When converting a vector of numbers from Lisp to C, it is assumed to be
1581 of format 16 if every element in the vector is an integer, and is assumed
1582 to be of format 32 if any element is a cons of two integers.
1584 When converting an object to C, it may be of the form (SYMBOL . <data>)
1585 where SYMBOL is what we should claim that the type is. Format and
1586 representation are as above. */
1591 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1593 unsigned char *data
;
1597 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1599 if (type
== dpyinfo
->Xatom_NULL
)
1602 /* Convert any 8-bit data to a string, for compactness. */
1603 else if (format
== 8)
1606 int require_encoding
= 0;
1612 ! NILP (buffer_defaults
.enable_multibyte_characters
)
1616 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1617 DATA to Emacs internal format because DATA may be encoded
1618 in compound text format. In addtion, if TYPE is `STRING'
1619 and DATA contains any 8-bit Latin-1 code, we should also
1621 if (type
== dpyinfo
->Xatom_TEXT
1622 || type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1623 require_encoding
= 1;
1624 else if (type
== XA_STRING
)
1627 for (i
= 0; i
< size
; i
++)
1629 if (data
[i
] >= 0x80)
1631 require_encoding
= 1;
1637 if (!require_encoding
)
1639 str
= make_unibyte_string ((char *) data
, size
);
1640 Vlast_coding_system_used
= Qraw_text
;
1646 struct coding_system coding
;
1648 if (NILP (Vnext_selection_coding_system
))
1649 Vnext_selection_coding_system
= Vselection_coding_system
;
1651 (Fcheck_coding_system(Vnext_selection_coding_system
), &coding
);
1652 coding
.src_multibyte
= 0;
1653 coding
.dst_multibyte
= 1;
1654 Vnext_selection_coding_system
= Qnil
;
1655 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
1656 /* We explicitely disable composition handling because
1657 selection data should not contain any composition
1659 coding
.composing
= COMPOSITION_DISABLED
;
1660 bufsize
= decoding_buffer_size (&coding
, size
);
1661 buf
= (unsigned char *) xmalloc (bufsize
);
1662 decode_coding (&coding
, data
, buf
, size
, bufsize
);
1663 str
= make_string_from_bytes ((char *) buf
,
1664 coding
.produced_char
, coding
.produced
);
1667 if (SYMBOLP (coding
.post_read_conversion
)
1668 && !NILP (Ffboundp (coding
.post_read_conversion
)))
1669 str
= run_pre_post_conversion_on_str (str
, &coding
, 0);
1670 Vlast_coding_system_used
= coding
.symbol
;
1672 compose_chars_in_text (0, SCHARS (str
), str
);
1675 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1676 a vector of symbols.
1678 else if (type
== XA_ATOM
)
1681 if (size
== sizeof (Atom
))
1682 return x_atom_to_symbol (display
, *((Atom
*) data
));
1685 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1687 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1688 Faset (v
, make_number (i
),
1689 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1694 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1695 If the number is > 16 bits, convert it to a cons of integers,
1696 16 bits in each half.
1698 else if (format
== 32 && size
== sizeof (long))
1699 return long_to_cons (((unsigned long *) data
) [0]);
1700 else if (format
== 16 && size
== sizeof (short))
1701 return make_number ((int) (((unsigned short *) data
) [0]));
1703 /* Convert any other kind of data to a vector of numbers, represented
1704 as above (as an integer, or a cons of two 16 bit integers.)
1706 else if (format
== 16)
1710 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1711 for (i
= 0; i
< size
/ 2; i
++)
1713 int j
= (int) ((unsigned short *) data
) [i
];
1714 Faset (v
, make_number (i
), make_number (j
));
1721 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1722 for (i
= 0; i
< size
/ 4; i
++)
1724 unsigned long j
= ((unsigned long *) data
) [i
];
1725 Faset (v
, make_number (i
), long_to_cons (j
));
1732 /* Use xfree, not XFree, to free the data obtained with this function. */
1735 lisp_data_to_selection_data (display
, obj
,
1736 data_ret
, type_ret
, size_ret
,
1737 format_ret
, nofree_ret
)
1740 unsigned char **data_ret
;
1742 unsigned int *size_ret
;
1746 Lisp_Object type
= Qnil
;
1747 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1751 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1755 if (CONSP (obj
) && NILP (XCDR (obj
)))
1759 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1760 { /* This is not the same as declining */
1766 else if (STRINGP (obj
))
1768 xassert (! STRING_MULTIBYTE (obj
));
1772 *size_ret
= SBYTES (obj
);
1773 *data_ret
= SDATA (obj
);
1776 else if (SYMBOLP (obj
))
1780 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1781 (*data_ret
) [sizeof (Atom
)] = 0;
1782 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1783 if (NILP (type
)) type
= QATOM
;
1785 else if (INTEGERP (obj
)
1786 && XINT (obj
) < 0xFFFF
1787 && XINT (obj
) > -0xFFFF)
1791 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1792 (*data_ret
) [sizeof (short)] = 0;
1793 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1794 if (NILP (type
)) type
= QINTEGER
;
1796 else if (INTEGERP (obj
)
1797 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1798 && (INTEGERP (XCDR (obj
))
1799 || (CONSP (XCDR (obj
))
1800 && INTEGERP (XCAR (XCDR (obj
)))))))
1804 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1805 (*data_ret
) [sizeof (long)] = 0;
1806 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1807 if (NILP (type
)) type
= QINTEGER
;
1809 else if (VECTORP (obj
))
1811 /* Lisp_Vectors may represent a set of ATOMs;
1812 a set of 16 or 32 bit INTEGERs;
1813 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1817 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1818 /* This vector is an ATOM set */
1820 if (NILP (type
)) type
= QATOM
;
1821 *size_ret
= XVECTOR (obj
)->size
;
1823 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1824 for (i
= 0; i
< *size_ret
; i
++)
1825 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1826 (*(Atom
**) data_ret
) [i
]
1827 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1829 Fsignal (Qerror
, /* Qselection_error */
1831 ("all elements of selection vector must have same type"),
1832 Fcons (obj
, Qnil
)));
1834 #if 0 /* #### MULTIPLE doesn't work yet */
1835 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1836 /* This vector is an ATOM_PAIR set */
1838 if (NILP (type
)) type
= QATOM_PAIR
;
1839 *size_ret
= XVECTOR (obj
)->size
;
1841 *data_ret
= (unsigned char *)
1842 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1843 for (i
= 0; i
< *size_ret
; i
++)
1844 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1846 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1847 if (XVECTOR (pair
)->size
!= 2)
1850 ("elements of the vector must be vectors of exactly two elements"),
1851 Fcons (pair
, Qnil
)));
1853 (*(Atom
**) data_ret
) [i
* 2]
1854 = symbol_to_x_atom (dpyinfo
, display
,
1855 XVECTOR (pair
)->contents
[0]);
1856 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1857 = symbol_to_x_atom (dpyinfo
, display
,
1858 XVECTOR (pair
)->contents
[1]);
1863 ("all elements of the vector must be of the same type"),
1864 Fcons (obj
, Qnil
)));
1869 /* This vector is an INTEGER set, or something like it */
1871 *size_ret
= XVECTOR (obj
)->size
;
1872 if (NILP (type
)) type
= QINTEGER
;
1874 for (i
= 0; i
< *size_ret
; i
++)
1875 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1877 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1878 Fsignal (Qerror
, /* Qselection_error */
1880 ("elements of selection vector must be integers or conses of integers"),
1881 Fcons (obj
, Qnil
)));
1883 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1884 for (i
= 0; i
< *size_ret
; i
++)
1885 if (*format_ret
== 32)
1886 (*((unsigned long **) data_ret
)) [i
]
1887 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1889 (*((unsigned short **) data_ret
)) [i
]
1890 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1894 Fsignal (Qerror
, /* Qselection_error */
1895 Fcons (build_string ("unrecognised selection data"),
1896 Fcons (obj
, Qnil
)));
1898 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1902 clean_local_selection_data (obj
)
1906 && INTEGERP (XCAR (obj
))
1907 && CONSP (XCDR (obj
))
1908 && INTEGERP (XCAR (XCDR (obj
)))
1909 && NILP (XCDR (XCDR (obj
))))
1910 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1913 && INTEGERP (XCAR (obj
))
1914 && INTEGERP (XCDR (obj
)))
1916 if (XINT (XCAR (obj
)) == 0)
1918 if (XINT (XCAR (obj
)) == -1)
1919 return make_number (- XINT (XCDR (obj
)));
1924 int size
= XVECTOR (obj
)->size
;
1927 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1928 copy
= Fmake_vector (make_number (size
), Qnil
);
1929 for (i
= 0; i
< size
; i
++)
1930 XVECTOR (copy
)->contents
[i
]
1931 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1937 /* Called from XTread_socket to handle SelectionNotify events.
1938 If it's the selection we are waiting for, stop waiting
1939 by setting the car of reading_selection_reply to non-nil.
1940 We store t there if the reply is successful, lambda if not. */
1943 x_handle_selection_notify (event
)
1944 XSelectionEvent
*event
;
1946 if (event
->requestor
!= reading_selection_window
)
1948 if (event
->selection
!= reading_which_selection
)
1951 TRACE0 ("Received SelectionNotify");
1952 XSETCAR (reading_selection_reply
,
1953 (event
->property
!= 0 ? Qt
: Qlambda
));
1957 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1958 Sx_own_selection_internal
, 2, 2, 0,
1959 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1960 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1961 \(Those are literal upper-case symbol names, since that's what X expects.)
1962 VALUE is typically a string, or a cons of two markers, but may be
1963 anything that the functions on `selection-converter-alist' know about. */)
1964 (selection_name
, selection_value
)
1965 Lisp_Object selection_name
, selection_value
;
1968 CHECK_SYMBOL (selection_name
);
1969 if (NILP (selection_value
)) error ("selection-value may not be nil");
1970 x_own_selection (selection_name
, selection_value
);
1971 return selection_value
;
1975 /* Request the selection value from the owner. If we are the owner,
1976 simply return our selection value. If we are not the owner, this
1977 will block until all of the data has arrived. */
1979 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1980 Sx_get_selection_internal
, 2, 2, 0,
1981 doc
: /* Return text selected from some X window.
1982 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1983 \(Those are literal upper-case symbol names, since that's what X expects.)
1984 TYPE is the type of data desired, typically `STRING'. */)
1985 (selection_symbol
, target_type
)
1986 Lisp_Object selection_symbol
, target_type
;
1988 Lisp_Object val
= Qnil
;
1989 struct gcpro gcpro1
, gcpro2
;
1990 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1992 CHECK_SYMBOL (selection_symbol
);
1994 #if 0 /* #### MULTIPLE doesn't work yet */
1995 if (CONSP (target_type
)
1996 && XCAR (target_type
) == QMULTIPLE
)
1998 CHECK_VECTOR (XCDR (target_type
));
1999 /* So we don't destructively modify this... */
2000 target_type
= copy_multiple_data (target_type
);
2004 CHECK_SYMBOL (target_type
);
2006 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2010 val
= x_get_foreign_selection (selection_symbol
, target_type
);
2015 && SYMBOLP (XCAR (val
)))
2018 if (CONSP (val
) && NILP (XCDR (val
)))
2021 val
= clean_local_selection_data (val
);
2027 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2028 Sx_disown_selection_internal
, 1, 2, 0,
2029 doc
: /* If we own the selection SELECTION, disown it.
2030 Disowning it means there is no such selection. */)
2032 Lisp_Object selection
;
2036 Atom selection_atom
;
2037 struct selection_input_event event
;
2039 struct x_display_info
*dpyinfo
;
2040 struct frame
*sf
= SELECTED_FRAME ();
2043 display
= FRAME_X_DISPLAY (sf
);
2044 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2045 CHECK_SYMBOL (selection
);
2047 timestamp
= last_event_timestamp
;
2049 timestamp
= cons_to_long (time
);
2051 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2052 return Qnil
; /* Don't disown the selection when we're not the owner. */
2054 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2057 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2060 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2061 generated for a window which owns the selection when that window sets
2062 the selection owner to None. The NCD server does, the MIT Sun4 server
2063 doesn't. So we synthesize one; this means we might get two, but
2064 that's ok, because the second one won't have any effect. */
2065 SELECTION_EVENT_DISPLAY (&event
) = display
;
2066 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2067 SELECTION_EVENT_TIME (&event
) = timestamp
;
2068 x_handle_selection_clear ((struct input_event
*) &event
);
2073 /* Get rid of all the selections in buffer BUFFER.
2074 This is used when we kill a buffer. */
2077 x_disown_buffer_selections (buffer
)
2081 struct buffer
*buf
= XBUFFER (buffer
);
2083 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2085 Lisp_Object elt
, value
;
2088 if (CONSP (value
) && MARKERP (XCAR (value
))
2089 && XMARKER (XCAR (value
))->buffer
== buf
)
2090 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2094 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2096 doc
: /* Whether the current Emacs process owns the given X Selection.
2097 The arg should be the name of the selection in question, typically one of
2098 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2099 \(Those are literal upper-case symbol names, since that's what X expects.)
2100 For convenience, the symbol nil is the same as `PRIMARY',
2101 and t is the same as `SECONDARY'. */)
2103 Lisp_Object selection
;
2106 CHECK_SYMBOL (selection
);
2107 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2108 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2110 if (NILP (Fassq (selection
, Vselection_alist
)))
2115 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2117 doc
: /* Whether there is an owner for the given X Selection.
2118 The arg should be the name of the selection in question, typically one of
2119 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2120 \(Those are literal upper-case symbol names, since that's what X expects.)
2121 For convenience, the symbol nil is the same as `PRIMARY',
2122 and t is the same as `SECONDARY'. */)
2124 Lisp_Object selection
;
2129 struct frame
*sf
= SELECTED_FRAME ();
2131 /* It should be safe to call this before we have an X frame. */
2132 if (! FRAME_X_P (sf
))
2135 dpy
= FRAME_X_DISPLAY (sf
);
2136 CHECK_SYMBOL (selection
);
2137 if (!NILP (Fx_selection_owner_p (selection
)))
2139 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2140 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2141 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2145 owner
= XGetSelectionOwner (dpy
, atom
);
2147 return (owner
? Qt
: Qnil
);
2151 #ifdef CUT_BUFFER_SUPPORT
2153 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2155 initialize_cut_buffers (display
, window
)
2159 unsigned char *data
= (unsigned char *) "";
2161 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2162 PropModeAppend, data, 0)
2163 FROB (XA_CUT_BUFFER0
);
2164 FROB (XA_CUT_BUFFER1
);
2165 FROB (XA_CUT_BUFFER2
);
2166 FROB (XA_CUT_BUFFER3
);
2167 FROB (XA_CUT_BUFFER4
);
2168 FROB (XA_CUT_BUFFER5
);
2169 FROB (XA_CUT_BUFFER6
);
2170 FROB (XA_CUT_BUFFER7
);
2176 #define CHECK_CUT_BUFFER(symbol) \
2177 { CHECK_SYMBOL ((symbol)); \
2178 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2179 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2180 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2181 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2183 Fcons (build_string ("doesn't name a cut buffer"), \
2184 Fcons ((symbol), Qnil))); \
2187 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2188 Sx_get_cut_buffer_internal
, 1, 1, 0,
2189 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2195 unsigned char *data
;
2202 struct x_display_info
*dpyinfo
;
2203 struct frame
*sf
= SELECTED_FRAME ();
2206 display
= FRAME_X_DISPLAY (sf
);
2207 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2208 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2209 CHECK_CUT_BUFFER (buffer
);
2210 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2212 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2213 &type
, &format
, &size
, 0);
2214 if (!data
|| !format
)
2217 if (format
!= 8 || type
!= XA_STRING
)
2219 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2220 Fcons (x_atom_to_symbol (display
, type
),
2221 Fcons (make_number (format
), Qnil
))));
2223 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2224 /* Use xfree, not XFree, because x_get_window_property
2225 calls xmalloc itself. */
2231 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2232 Sx_store_cut_buffer_internal
, 2, 2, 0,
2233 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2235 Lisp_Object buffer
, string
;
2239 unsigned char *data
;
2241 int bytes_remaining
;
2244 struct frame
*sf
= SELECTED_FRAME ();
2247 display
= FRAME_X_DISPLAY (sf
);
2248 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2250 max_bytes
= SELECTION_QUANTUM (display
);
2251 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2252 max_bytes
= MAX_SELECTION_QUANTUM
;
2254 CHECK_CUT_BUFFER (buffer
);
2255 CHECK_STRING (string
);
2256 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2258 data
= (unsigned char *) SDATA (string
);
2259 bytes
= SBYTES (string
);
2260 bytes_remaining
= bytes
;
2262 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2264 initialize_cut_buffers (display
, window
);
2265 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2270 /* Don't mess up with an empty value. */
2271 if (!bytes_remaining
)
2272 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2273 PropModeReplace
, data
, 0);
2275 while (bytes_remaining
)
2277 int chunk
= (bytes_remaining
< max_bytes
2278 ? bytes_remaining
: max_bytes
);
2279 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2280 (bytes_remaining
== bytes
2285 bytes_remaining
-= chunk
;
2292 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2293 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2294 doc
: /* Rotate the values of the cut buffers by the given number of step.
2295 Positive means shift the values forward, negative means backward. */)
2302 struct frame
*sf
= SELECTED_FRAME ();
2305 display
= FRAME_X_DISPLAY (sf
);
2306 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2310 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2312 initialize_cut_buffers (display
, window
);
2313 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2316 props
[0] = XA_CUT_BUFFER0
;
2317 props
[1] = XA_CUT_BUFFER1
;
2318 props
[2] = XA_CUT_BUFFER2
;
2319 props
[3] = XA_CUT_BUFFER3
;
2320 props
[4] = XA_CUT_BUFFER4
;
2321 props
[5] = XA_CUT_BUFFER5
;
2322 props
[6] = XA_CUT_BUFFER6
;
2323 props
[7] = XA_CUT_BUFFER7
;
2325 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2335 defsubr (&Sx_get_selection_internal
);
2336 defsubr (&Sx_own_selection_internal
);
2337 defsubr (&Sx_disown_selection_internal
);
2338 defsubr (&Sx_selection_owner_p
);
2339 defsubr (&Sx_selection_exists_p
);
2341 #ifdef CUT_BUFFER_SUPPORT
2342 defsubr (&Sx_get_cut_buffer_internal
);
2343 defsubr (&Sx_store_cut_buffer_internal
);
2344 defsubr (&Sx_rotate_cut_buffers_internal
);
2347 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2348 staticpro (&reading_selection_reply
);
2349 reading_selection_window
= 0;
2350 reading_which_selection
= 0;
2352 property_change_wait_list
= 0;
2353 prop_location_identifier
= 0;
2354 property_change_reply
= Fcons (Qnil
, Qnil
);
2355 staticpro (&property_change_reply
);
2357 Vselection_alist
= Qnil
;
2358 staticpro (&Vselection_alist
);
2360 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2361 doc
: /* An alist associating X Windows selection-types with functions.
2362 These functions are called to convert the selection, with three args:
2363 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2364 a desired type to which the selection should be converted;
2365 and the local selection value (whatever was given to `x-own-selection').
2367 The function should return the value to send to the X server
2368 \(typically a string). A return value of nil
2369 means that the conversion could not be done.
2370 A return value which is the symbol `NULL'
2371 means that a side-effect was executed,
2372 and there is no meaningful selection value. */);
2373 Vselection_converter_alist
= Qnil
;
2375 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2376 doc
: /* A list of functions to be called when Emacs loses an X selection.
2377 \(This happens when some other X client makes its own selection
2378 or when a Lisp program explicitly clears the selection.)
2379 The functions are called with one argument, the selection type
2380 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2381 Vx_lost_selection_hooks
= Qnil
;
2383 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2384 doc
: /* A list of functions to be called when Emacs answers a selection request.
2385 The functions are called with four arguments:
2386 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2387 - the selection-type which Emacs was asked to convert the
2388 selection into before sending (for example, `STRING' or `LENGTH');
2389 - a flag indicating success or failure for responding to the request.
2390 We might have failed (and declined the request) for any number of reasons,
2391 including being asked for a selection that we no longer own, or being asked
2392 to convert into a type that we don't know about or that is inappropriate.
2393 This hook doesn't let you change the behavior of Emacs's selection replies,
2394 it merely informs you that they have happened. */);
2395 Vx_sent_selection_hooks
= Qnil
;
2397 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2398 doc
: /* Coding system for communicating with other X clients.
2399 When sending or receiving text via cut_buffer, selection, and clipboard,
2400 the text is encoded or decoded by this coding system.
2401 The default value is `compound-text-with-extensions'. */);
2402 Vselection_coding_system
= intern ("compound-text-with-extensions");
2404 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2405 doc
: /* Coding system for the next communication with other X clients.
2406 Usually, `selection-coding-system' is used for communicating with
2407 other X clients. But, if this variable is set, it is used for the
2408 next communication only. After the communication, this variable is
2410 Vnext_selection_coding_system
= Qnil
;
2412 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2413 doc
: /* Number of milliseconds to wait for a selection reply.
2414 If the selection owner doesn't reply in this time, we give up.
2415 A value of 0 means wait as long as necessary. This is initialized from the
2416 \"*selectionTimeout\" resource. */);
2417 x_selection_timeout
= 0;
2419 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2420 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2421 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2422 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2423 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2424 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2425 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2426 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2427 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2428 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2429 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2430 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2431 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2432 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2433 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2434 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2435 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2436 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2437 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2438 staticpro (&Qcompound_text_with_extensions
);
2440 #ifdef CUT_BUFFER_SUPPORT
2441 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2442 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2443 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2444 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2445 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2446 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2447 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2448 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);