1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
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 3 of the License, or
10 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
21 /* Rewritten by jwz */
24 #include <stdio.h> /* termhooks.h needs this */
27 #ifdef HAVE_SYS_TYPES_H
28 #include <sys/types.h>
34 #include "xterm.h" /* for all of the X includes */
35 #include "dispextern.h" /* frame.h seems to want this */
36 #include "frame.h" /* Need this to get the X window of selected_frame */
37 #include "blockinput.h"
40 #include "termhooks.h"
43 #include <X11/Xproto.h>
47 static Lisp_Object
x_atom_to_symbol (Display
*dpy
, Atom atom
);
48 static Atom
symbol_to_x_atom (struct x_display_info
*, Display
*,
50 static void x_own_selection (Lisp_Object
, Lisp_Object
);
51 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int);
52 static void x_decline_selection_request (struct input_event
*);
53 static Lisp_Object
x_selection_request_lisp_error (Lisp_Object
);
54 static Lisp_Object
queue_selection_requests_unwind (Lisp_Object
);
55 static Lisp_Object
some_frame_on_display (struct x_display_info
*);
56 static Lisp_Object
x_catch_errors_unwind (Lisp_Object
);
57 static void x_reply_selection_request (struct input_event
*, int,
58 unsigned char *, int, Atom
);
59 static int waiting_for_other_props_on_window (Display
*, Window
);
60 static struct prop_location
*expect_property_change (Display
*, Window
,
62 static void unexpect_property_change (struct prop_location
*);
63 static Lisp_Object
wait_for_property_change_unwind (Lisp_Object
);
64 static void wait_for_property_change (struct prop_location
*);
65 static Lisp_Object
x_get_foreign_selection (Lisp_Object
,
68 static void x_get_window_property (Display
*, Window
, Atom
,
69 unsigned char **, int *,
70 Atom
*, int *, unsigned long *, int);
71 static void receive_incremental_selection (Display
*, Window
, Atom
,
72 Lisp_Object
, unsigned,
73 unsigned char **, int *,
74 Atom
*, int *, unsigned long *);
75 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
78 static Lisp_Object
selection_data_to_lisp_data (Display
*,
79 const unsigned char *,
81 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
82 unsigned char **, Atom
*,
83 unsigned *, int *, int *);
84 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
86 /* Printing traces to stderr. */
88 #ifdef TRACE_SELECTION
90 fprintf (stderr, "%d: " fmt "\n", getpid ())
91 #define TRACE1(fmt, a0) \
92 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
93 #define TRACE2(fmt, a0, a1) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
95 #define TRACE3(fmt, a0, a1, a2) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
98 #define TRACE0(fmt) (void) 0
99 #define TRACE1(fmt, a0) (void) 0
100 #define TRACE2(fmt, a0, a1) (void) 0
101 #define TRACE3(fmt, a0, a1) (void) 0
105 Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
106 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
109 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
110 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
112 Lisp_Object Qcompound_text_with_extensions
;
114 static Lisp_Object Qforeign_selection
;
116 /* If this is a smaller number than the max-request-size of the display,
117 emacs will use INCR selection transfer when the selection is larger
118 than this. The max-request-size is usually around 64k, so if you want
119 emacs to use incremental selection transfers when the selection is
120 smaller than that, set this. I added this mostly for debugging the
121 incremental transfer stuff, but it might improve server performance. */
122 #define MAX_SELECTION_QUANTUM 0xFFFFFF
124 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
126 /* The timestamp of the last input event Emacs received from the X server. */
127 /* Defined in keyboard.c. */
128 extern unsigned long last_event_timestamp
;
132 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
135 struct selection_event_queue
137 struct input_event event
;
138 struct selection_event_queue
*next
;
141 static struct selection_event_queue
*selection_queue
;
143 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
145 static int x_queue_selection_requests
;
147 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
150 x_queue_event (struct input_event
*event
)
152 struct selection_event_queue
*queue_tmp
;
154 /* Don't queue repeated requests.
155 This only happens for large requests which uses the incremental protocol. */
156 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
158 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
160 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
161 x_decline_selection_request (event
);
167 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
169 if (queue_tmp
!= NULL
)
171 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
172 queue_tmp
->event
= *event
;
173 queue_tmp
->next
= selection_queue
;
174 selection_queue
= queue_tmp
;
178 /* Start queuing SELECTION_REQUEST_EVENT events. */
181 x_start_queuing_selection_requests (void)
183 if (x_queue_selection_requests
)
186 x_queue_selection_requests
++;
187 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
190 /* Stop queuing SELECTION_REQUEST_EVENT events. */
193 x_stop_queuing_selection_requests (void)
195 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
196 --x_queue_selection_requests
;
198 /* Take all the queued events and put them back
199 so that they get processed afresh. */
201 while (selection_queue
!= NULL
)
203 struct selection_event_queue
*queue_tmp
= selection_queue
;
204 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
205 kbd_buffer_unget_event (&queue_tmp
->event
);
206 selection_queue
= queue_tmp
->next
;
207 xfree ((char *)queue_tmp
);
212 /* This converts a Lisp symbol to a server Atom, avoiding a server
213 roundtrip whenever possible. */
216 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Display
*display
, Lisp_Object sym
)
219 if (NILP (sym
)) return 0;
220 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
221 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
222 if (EQ (sym
, QSTRING
)) return XA_STRING
;
223 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
224 if (EQ (sym
, QATOM
)) return XA_ATOM
;
225 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
226 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
227 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
228 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
229 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
230 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
231 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
232 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
233 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
234 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
235 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
236 if (!SYMBOLP (sym
)) abort ();
238 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
240 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
246 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
247 and calls to intern whenever possible. */
250 x_atom_to_symbol (Display
*dpy
, Atom atom
)
252 struct x_display_info
*dpyinfo
;
273 dpyinfo
= x_display_info_for_display (dpy
);
274 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
276 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
278 if (atom
== dpyinfo
->Xatom_TEXT
)
280 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
281 return QCOMPOUND_TEXT
;
282 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
284 if (atom
== dpyinfo
->Xatom_DELETE
)
286 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
288 if (atom
== dpyinfo
->Xatom_INCR
)
290 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
292 if (atom
== dpyinfo
->Xatom_TARGETS
)
294 if (atom
== dpyinfo
->Xatom_NULL
)
298 str
= XGetAtomName (dpy
, atom
);
300 TRACE1 ("XGetAtomName --> %s", str
);
301 if (! str
) return Qnil
;
304 /* This was allocated by Xlib, so use XFree. */
310 /* Do protocol to assert ourself as a selection owner.
311 Update the Vselection_alist so that we can reply to later requests for
315 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
)
317 struct frame
*sf
= SELECTED_FRAME ();
318 Window selecting_window
;
320 Time time
= last_event_timestamp
;
322 struct x_display_info
*dpyinfo
;
324 if (! FRAME_X_P (sf
))
327 selecting_window
= FRAME_X_WINDOW (sf
);
328 display
= FRAME_X_DISPLAY (sf
);
329 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
331 CHECK_SYMBOL (selection_name
);
332 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
335 x_catch_errors (display
);
336 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
337 x_check_errors (display
, "Can't set selection: %s");
341 /* Now update the local cache */
343 Lisp_Object selection_time
;
344 Lisp_Object selection_data
;
345 Lisp_Object prev_value
;
347 selection_time
= long_to_cons ((unsigned long) time
);
348 selection_data
= list4 (selection_name
, selection_value
,
349 selection_time
, selected_frame
);
350 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
352 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
354 /* If we already owned the selection, remove the old selection data.
355 Perhaps we should destructively modify it instead.
356 Don't use Fdelq as that may QUIT. */
357 if (!NILP (prev_value
))
359 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
360 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
361 if (EQ (prev_value
, Fcar (XCDR (rest
))))
363 XSETCDR (rest
, Fcdr (XCDR (rest
)));
370 /* Given a selection-name and desired type, look up our local copy of
371 the selection value and convert it to the type.
372 The value is nil or a string.
373 This function is used both for remote requests (LOCAL_REQUEST is zero)
374 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
376 This calls random Lisp code, and may signal or gc. */
379 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, int local_request
)
381 Lisp_Object local_value
;
382 Lisp_Object handler_fn
, value
, type
, check
;
385 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
387 if (NILP (local_value
)) return Qnil
;
389 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
390 if (EQ (target_type
, QTIMESTAMP
))
393 value
= XCAR (XCDR (XCDR (local_value
)));
396 else if (EQ (target_type
, QDELETE
))
399 Fx_disown_selection_internal
401 XCAR (XCDR (XCDR (local_value
))));
406 #if 0 /* #### MULTIPLE doesn't work yet */
407 else if (CONSP (target_type
)
408 && XCAR (target_type
) == QMULTIPLE
)
413 pairs
= XCDR (target_type
);
414 size
= XVECTOR (pairs
)->size
;
415 /* If the target is MULTIPLE, then target_type looks like
416 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
417 We modify the second element of each pair in the vector and
418 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
420 for (i
= 0; i
< size
; i
++)
423 pair
= XVECTOR (pairs
)->contents
[i
];
424 XVECTOR (pair
)->contents
[1]
425 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
426 XVECTOR (pair
)->contents
[1],
434 /* Don't allow a quit within the converter.
435 When the user types C-g, he would be surprised
436 if by luck it came during a converter. */
437 count
= SPECPDL_INDEX ();
438 specbind (Qinhibit_quit
, Qt
);
440 CHECK_SYMBOL (target_type
);
441 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
442 /* gcpro is not needed here since nothing but HANDLER_FN
443 is live, and that ought to be a symbol. */
445 if (!NILP (handler_fn
))
446 value
= call3 (handler_fn
,
447 selection_symbol
, (local_request
? Qnil
: target_type
),
448 XCAR (XCDR (local_value
)));
451 unbind_to (count
, Qnil
);
454 /* Make sure this value is of a type that we could transmit
455 to another X client. */
459 && SYMBOLP (XCAR (value
)))
461 check
= XCDR (value
);
469 /* Check for a value that cons_to_long could handle. */
470 else if (CONSP (check
)
471 && INTEGERP (XCAR (check
))
472 && (INTEGERP (XCDR (check
))
474 (CONSP (XCDR (check
))
475 && INTEGERP (XCAR (XCDR (check
)))
476 && NILP (XCDR (XCDR (check
))))))
479 signal_error ("Invalid data returned by selection-conversion function",
480 list2 (handler_fn
, value
));
483 /* Subroutines of x_reply_selection_request. */
485 /* Send a SelectionNotify event to the requestor with property=None,
486 meaning we were unable to do what they wanted. */
489 x_decline_selection_request (struct input_event
*event
)
491 XSelectionEvent reply
;
493 reply
.type
= SelectionNotify
;
494 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
495 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
496 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
497 reply
.time
= SELECTION_EVENT_TIME (event
);
498 reply
.target
= SELECTION_EVENT_TARGET (event
);
499 reply
.property
= None
;
501 /* The reason for the error may be that the receiver has
502 died in the meantime. Handle that case. */
504 x_catch_errors (reply
.display
);
505 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
506 XFlush (reply
.display
);
511 /* This is the selection request currently being processed.
512 It is set to zero when the request is fully processed. */
513 static struct input_event
*x_selection_current_request
;
515 /* Display info in x_selection_request. */
517 static struct x_display_info
*selection_request_dpyinfo
;
519 /* Used as an unwind-protect clause so that, if a selection-converter signals
520 an error, we tell the requester that we were unable to do what they wanted
521 before we throw to top-level or go into the debugger or whatever. */
524 x_selection_request_lisp_error (Lisp_Object ignore
)
526 if (x_selection_current_request
!= 0
527 && selection_request_dpyinfo
->display
)
528 x_decline_selection_request (x_selection_current_request
);
533 x_catch_errors_unwind (Lisp_Object dummy
)
542 /* This stuff is so that INCR selections are reentrant (that is, so we can
543 be servicing multiple INCR selection requests simultaneously.) I haven't
544 actually tested that yet. */
546 /* Keep a list of the property changes that are awaited. */
556 struct prop_location
*next
;
559 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
560 static void wait_for_property_change (struct prop_location
*location
);
561 static void unexpect_property_change (struct prop_location
*location
);
562 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
564 static int prop_location_identifier
;
566 static Lisp_Object property_change_reply
;
568 static struct prop_location
*property_change_reply_object
;
570 static struct prop_location
*property_change_wait_list
;
573 queue_selection_requests_unwind (Lisp_Object tem
)
575 x_stop_queuing_selection_requests ();
579 /* Return some frame whose display info is DPYINFO.
580 Return nil if there is none. */
583 some_frame_on_display (struct x_display_info
*dpyinfo
)
585 Lisp_Object list
, frame
;
587 FOR_EACH_FRAME (list
, frame
)
589 if (FRAME_X_P (XFRAME (frame
))
590 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
597 /* Send the reply to a selection request event EVENT.
598 TYPE is the type of selection data requested.
599 DATA and SIZE describe the data to send, already converted.
600 FORMAT is the unit-size (in bits) of the data to be transmitted. */
602 #ifdef TRACE_SELECTION
603 static int x_reply_selection_request_cnt
;
604 #endif /* TRACE_SELECTION */
607 x_reply_selection_request (struct input_event
*event
, int format
, unsigned char *data
, int size
, Atom type
)
609 XSelectionEvent reply
;
610 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
611 Window window
= SELECTION_EVENT_REQUESTOR (event
);
613 int format_bytes
= format
/8;
614 int max_bytes
= SELECTION_QUANTUM (display
);
615 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
616 int count
= SPECPDL_INDEX ();
618 if (max_bytes
> MAX_SELECTION_QUANTUM
)
619 max_bytes
= MAX_SELECTION_QUANTUM
;
621 reply
.type
= SelectionNotify
;
622 reply
.display
= display
;
623 reply
.requestor
= window
;
624 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
625 reply
.time
= SELECTION_EVENT_TIME (event
);
626 reply
.target
= SELECTION_EVENT_TARGET (event
);
627 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
628 if (reply
.property
== None
)
629 reply
.property
= reply
.target
;
632 /* The protected block contains wait_for_property_change, which can
633 run random lisp code (process handlers) or signal. Therefore, we
634 put the x_uncatch_errors call in an unwind. */
635 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
636 x_catch_errors (display
);
638 #ifdef TRACE_SELECTION
640 char *sel
= XGetAtomName (display
, reply
.selection
);
641 char *tgt
= XGetAtomName (display
, reply
.target
);
642 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++x_reply_selection_request_cnt
);
643 if (sel
) XFree (sel
);
644 if (tgt
) XFree (tgt
);
646 #endif /* TRACE_SELECTION */
648 /* Store the data on the requested property.
649 If the selection is large, only store the first N bytes of it.
651 bytes_remaining
= size
* format_bytes
;
652 if (bytes_remaining
<= max_bytes
)
654 /* Send all the data at once, with minimal handshaking. */
655 TRACE1 ("Sending all %d bytes", bytes_remaining
);
656 XChangeProperty (display
, window
, reply
.property
, type
, format
,
657 PropModeReplace
, data
, size
);
658 /* At this point, the selection was successfully stored; ack it. */
659 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
663 /* Send an INCR selection. */
664 struct prop_location
*wait_object
;
668 frame
= some_frame_on_display (dpyinfo
);
670 /* If the display no longer has frames, we can't expect
671 to get many more selection requests from it, so don't
672 bother trying to queue them. */
675 x_start_queuing_selection_requests ();
677 record_unwind_protect (queue_selection_requests_unwind
,
681 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
682 error ("Attempt to transfer an INCR to ourself!");
684 TRACE2 ("Start sending %d bytes incrementally (%s)",
685 bytes_remaining
, XGetAtomName (display
, reply
.property
));
686 wait_object
= expect_property_change (display
, window
, reply
.property
,
689 TRACE1 ("Set %s to number of bytes to send",
690 XGetAtomName (display
, reply
.property
));
692 /* XChangeProperty expects an array of long even if long is more than
696 value
[0] = bytes_remaining
;
697 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
699 (unsigned char *) value
, 1);
702 XSelectInput (display
, window
, PropertyChangeMask
);
704 /* Tell 'em the INCR data is there... */
705 TRACE0 ("Send SelectionNotify event");
706 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
709 had_errors
= x_had_errors_p (display
);
712 /* First, wait for the requester to ack by deleting the property.
713 This can run random lisp code (process handlers) or signal. */
716 TRACE1 ("Waiting for ACK (deletion of %s)",
717 XGetAtomName (display
, reply
.property
));
718 wait_for_property_change (wait_object
);
721 unexpect_property_change (wait_object
);
724 while (bytes_remaining
)
726 int i
= ((bytes_remaining
< max_bytes
)
728 : max_bytes
) / format_bytes
;
733 = expect_property_change (display
, window
, reply
.property
,
736 TRACE1 ("Sending increment of %d elements", i
);
737 TRACE1 ("Set %s to increment data",
738 XGetAtomName (display
, reply
.property
));
740 /* Append the next chunk of data to the property. */
741 XChangeProperty (display
, window
, reply
.property
, type
, format
,
742 PropModeAppend
, data
, i
);
743 bytes_remaining
-= i
* format_bytes
;
745 data
+= i
* sizeof (long);
747 data
+= i
* format_bytes
;
749 had_errors
= x_had_errors_p (display
);
755 /* Now wait for the requester to ack this chunk by deleting the
756 property. This can run random lisp code or signal. */
757 TRACE1 ("Waiting for increment ACK (deletion of %s)",
758 XGetAtomName (display
, reply
.property
));
759 wait_for_property_change (wait_object
);
762 /* Now write a zero-length chunk to the property to tell the
763 requester that we're done. */
765 if (! waiting_for_other_props_on_window (display
, window
))
766 XSelectInput (display
, window
, 0L);
768 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
769 XGetAtomName (display
, reply
.property
));
770 XChangeProperty (display
, window
, reply
.property
, type
, format
,
771 PropModeReplace
, data
, 0);
772 TRACE0 ("Done sending incrementally");
775 /* rms, 2003-01-03: I think I have fixed this bug. */
776 /* The window we're communicating with may have been deleted
777 in the meantime (that's a real situation from a bug report).
778 In this case, there may be events in the event queue still
779 refering to the deleted window, and we'll get a BadWindow error
780 in XTread_socket when processing the events. I don't have
781 an idea how to fix that. gerd, 2001-01-98. */
782 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
783 delivered before uncatch errors. */
784 XSync (display
, False
);
787 /* GTK queues events in addition to the queue in Xlib. So we
788 UNBLOCK to enter the event loop and get possible errors delivered,
789 and then BLOCK again because x_uncatch_errors requires it. */
791 /* This calls x_uncatch_errors. */
792 unbind_to (count
, Qnil
);
796 /* Handle a SelectionRequest event EVENT.
797 This is called from keyboard.c when such an event is found in the queue. */
800 x_handle_selection_request (struct input_event
*event
)
802 struct gcpro gcpro1
, gcpro2
, gcpro3
;
803 Lisp_Object local_selection_data
;
804 Lisp_Object selection_symbol
;
805 Lisp_Object target_symbol
;
806 Lisp_Object converted_selection
;
807 Time local_selection_time
;
808 Lisp_Object successful_p
;
810 struct x_display_info
*dpyinfo
811 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
813 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
814 (unsigned long) SELECTION_EVENT_REQUESTOR (event
),
815 (unsigned long) SELECTION_EVENT_TIME (event
));
817 local_selection_data
= Qnil
;
818 target_symbol
= Qnil
;
819 converted_selection
= Qnil
;
822 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
824 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
825 SELECTION_EVENT_SELECTION (event
));
827 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
829 if (NILP (local_selection_data
))
831 /* Someone asked for the selection, but we don't have it any more.
833 x_decline_selection_request (event
);
837 local_selection_time
= (Time
)
838 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
840 if (SELECTION_EVENT_TIME (event
) != CurrentTime
841 && local_selection_time
> SELECTION_EVENT_TIME (event
))
843 /* Someone asked for the selection, and we have one, but not the one
846 x_decline_selection_request (event
);
850 x_selection_current_request
= event
;
851 count
= SPECPDL_INDEX ();
852 selection_request_dpyinfo
= dpyinfo
;
853 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
855 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
856 SELECTION_EVENT_TARGET (event
));
858 #if 0 /* #### MULTIPLE doesn't work yet */
859 if (EQ (target_symbol
, QMULTIPLE
))
860 target_symbol
= fetch_multiple_target (event
);
863 /* Convert lisp objects back into binary data */
866 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
868 if (! NILP (converted_selection
))
876 if (CONSP (converted_selection
) && NILP (XCDR (converted_selection
)))
878 x_decline_selection_request (event
);
882 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
884 &data
, &type
, &size
, &format
, &nofree
);
886 x_reply_selection_request (event
, format
, data
, size
, type
);
889 /* Indicate we have successfully processed this event. */
890 x_selection_current_request
= 0;
892 /* Use xfree, not XFree, because lisp_data_to_selection_data
893 calls xmalloc itself. */
899 unbind_to (count
, Qnil
);
903 /* Let random lisp code notice that the selection has been asked for. */
906 rest
= Vx_sent_selection_functions
;
907 if (!EQ (rest
, Qunbound
))
908 for (; CONSP (rest
); rest
= Fcdr (rest
))
909 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
915 /* Handle a SelectionClear event EVENT, which indicates that some
916 client cleared out our previously asserted selection.
917 This is called from keyboard.c when such an event is found in the queue. */
920 x_handle_selection_clear (struct input_event
*event
)
922 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
923 Atom selection
= SELECTION_EVENT_SELECTION (event
);
924 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
926 Lisp_Object selection_symbol
, local_selection_data
;
927 Time local_selection_time
;
928 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
929 struct x_display_info
*t_dpyinfo
;
931 TRACE0 ("x_handle_selection_clear");
933 /* If the new selection owner is also Emacs,
934 don't clear the new selection. */
936 /* Check each display on the same terminal,
937 to see if this Emacs job now owns the selection
938 through that display. */
939 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
940 if (t_dpyinfo
->terminal
->kboard
== dpyinfo
->terminal
->kboard
)
943 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
944 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
952 selection_symbol
= x_atom_to_symbol (display
, selection
);
954 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
956 /* Well, we already believe that we don't own it, so that's just fine. */
957 if (NILP (local_selection_data
)) return;
959 local_selection_time
= (Time
)
960 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
962 /* This SelectionClear is for a selection that we no longer own, so we can
963 disregard it. (That is, we have reasserted the selection since this
964 request was generated.) */
966 if (changed_owner_time
!= CurrentTime
967 && local_selection_time
> changed_owner_time
)
970 /* Otherwise, we're really honest and truly being told to drop it.
971 Don't use Fdelq as that may QUIT;. */
973 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
974 Vselection_alist
= Fcdr (Vselection_alist
);
978 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
979 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
981 XSETCDR (rest
, Fcdr (XCDR (rest
)));
986 /* Let random lisp code notice that the selection has been stolen. */
990 rest
= Vx_lost_selection_functions
;
991 if (!EQ (rest
, Qunbound
))
993 for (; CONSP (rest
); rest
= Fcdr (rest
))
994 call1 (Fcar (rest
), selection_symbol
);
995 prepare_menu_bars ();
996 redisplay_preserve_echo_area (20);
1002 x_handle_selection_event (struct input_event
*event
)
1004 TRACE0 ("x_handle_selection_event");
1006 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1008 if (x_queue_selection_requests
)
1009 x_queue_event (event
);
1011 x_handle_selection_request (event
);
1014 x_handle_selection_clear (event
);
1018 /* Clear all selections that were made from frame F.
1019 We do this when about to delete a frame. */
1022 x_clear_frame_selections (FRAME_PTR f
)
1027 XSETFRAME (frame
, f
);
1029 /* Otherwise, we're really honest and truly being told to drop it.
1030 Don't use Fdelq as that may QUIT;. */
1032 /* Delete elements from the beginning of Vselection_alist. */
1033 while (!NILP (Vselection_alist
)
1034 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1036 /* Let random Lisp code notice that the selection has been stolen. */
1037 Lisp_Object hooks
, selection_symbol
;
1039 hooks
= Vx_lost_selection_functions
;
1040 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1042 if (!EQ (hooks
, Qunbound
))
1044 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1045 call1 (Fcar (hooks
), selection_symbol
);
1046 #if 0 /* This can crash when deleting a frame
1047 from x_connection_closed. Anyway, it seems unnecessary;
1048 something else should cause a redisplay. */
1049 redisplay_preserve_echo_area (21);
1053 Vselection_alist
= Fcdr (Vselection_alist
);
1056 /* Delete elements after the beginning of Vselection_alist. */
1057 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1058 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1060 /* Let random Lisp code notice that the selection has been stolen. */
1061 Lisp_Object hooks
, selection_symbol
;
1063 hooks
= Vx_lost_selection_functions
;
1064 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1066 if (!EQ (hooks
, Qunbound
))
1068 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1069 call1 (Fcar (hooks
), selection_symbol
);
1070 #if 0 /* See above */
1071 redisplay_preserve_echo_area (22);
1074 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1079 /* Nonzero if any properties for DISPLAY and WINDOW
1080 are on the list of what we are waiting for. */
1083 waiting_for_other_props_on_window (Display
*display
, Window window
)
1085 struct prop_location
*rest
= property_change_wait_list
;
1087 if (rest
->display
== display
&& rest
->window
== window
)
1094 /* Add an entry to the list of property changes we are waiting for.
1095 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1096 The return value is a number that uniquely identifies
1097 this awaited property change. */
1099 static struct prop_location
*
1100 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1102 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1103 pl
->identifier
= ++prop_location_identifier
;
1104 pl
->display
= display
;
1105 pl
->window
= window
;
1106 pl
->property
= property
;
1107 pl
->desired_state
= state
;
1108 pl
->next
= property_change_wait_list
;
1110 property_change_wait_list
= pl
;
1114 /* Delete an entry from the list of property changes we are waiting for.
1115 IDENTIFIER is the number that uniquely identifies the entry. */
1118 unexpect_property_change (struct prop_location
*location
)
1120 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1123 if (rest
== location
)
1126 prev
->next
= rest
->next
;
1128 property_change_wait_list
= rest
->next
;
1137 /* Remove the property change expectation element for IDENTIFIER. */
1140 wait_for_property_change_unwind (Lisp_Object loc
)
1142 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1144 unexpect_property_change (location
);
1145 if (location
== property_change_reply_object
)
1146 property_change_reply_object
= 0;
1150 /* Actually wait for a property change.
1151 IDENTIFIER should be the value that expect_property_change returned. */
1154 wait_for_property_change (struct prop_location
*location
)
1157 int count
= SPECPDL_INDEX ();
1159 if (property_change_reply_object
)
1162 /* Make sure to do unexpect_property_change if we quit or err. */
1163 record_unwind_protect (wait_for_property_change_unwind
,
1164 make_save_value (location
, 0));
1166 XSETCAR (property_change_reply
, Qnil
);
1167 property_change_reply_object
= location
;
1169 /* If the event we are waiting for arrives beyond here, it will set
1170 property_change_reply, because property_change_reply_object says so. */
1171 if (! location
->arrived
)
1173 secs
= x_selection_timeout
/ 1000;
1174 usecs
= (x_selection_timeout
% 1000) * 1000;
1175 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1176 wait_reading_process_output (secs
, usecs
, 0, 0,
1177 property_change_reply
, NULL
, 0);
1179 if (NILP (XCAR (property_change_reply
)))
1181 TRACE0 (" Timed out");
1182 error ("Timed out waiting for property-notify event");
1186 unbind_to (count
, Qnil
);
1189 /* Called from XTread_socket in response to a PropertyNotify event. */
1192 x_handle_property_notify (XPropertyEvent
*event
)
1194 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1199 && rest
->property
== event
->atom
1200 && rest
->window
== event
->window
1201 && rest
->display
== event
->display
1202 && rest
->desired_state
== event
->state
)
1204 TRACE2 ("Expected %s of property %s",
1205 (event
->state
== PropertyDelete
? "deletion" : "change"),
1206 XGetAtomName (event
->display
, event
->atom
));
1210 /* If this is the one wait_for_property_change is waiting for,
1211 tell it to wake up. */
1212 if (rest
== property_change_reply_object
)
1213 XSETCAR (property_change_reply
, Qt
);
1225 #if 0 /* #### MULTIPLE doesn't work yet */
1228 fetch_multiple_target (event
)
1229 XSelectionRequestEvent
*event
;
1231 Display
*display
= event
->display
;
1232 Window window
= event
->requestor
;
1233 Atom target
= event
->target
;
1234 Atom selection_atom
= event
->selection
;
1239 x_get_window_property_as_lisp_data (display
, window
, target
,
1240 QMULTIPLE
, selection_atom
));
1244 copy_multiple_data (obj
)
1251 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1254 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1255 for (i
= 0; i
< size
; i
++)
1257 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1258 CHECK_VECTOR (vec2
);
1259 if (XVECTOR (vec2
)->size
!= 2)
1260 /* ??? Confusing error message */
1261 signal_error ("Vectors must be of length 2", vec2
);
1262 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1263 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1264 = XVECTOR (vec2
)->contents
[0];
1265 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1266 = XVECTOR (vec2
)->contents
[1];
1274 /* Variables for communication with x_handle_selection_notify. */
1275 static Atom reading_which_selection
;
1276 static Lisp_Object reading_selection_reply
;
1277 static Window reading_selection_window
;
1279 /* Do protocol to read selection-data from the server.
1280 Converts this to Lisp data and returns it. */
1283 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
1285 struct frame
*sf
= SELECTED_FRAME ();
1286 Window requestor_window
;
1288 struct x_display_info
*dpyinfo
;
1289 Time requestor_time
= last_event_timestamp
;
1290 Atom target_property
;
1291 Atom selection_atom
;
1294 int count
= SPECPDL_INDEX ();
1297 if (! FRAME_X_P (sf
))
1300 requestor_window
= FRAME_X_WINDOW (sf
);
1301 display
= FRAME_X_DISPLAY (sf
);
1302 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1303 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1304 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1306 if (CONSP (target_type
))
1307 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1309 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1311 if (! NILP (time_stamp
))
1313 if (CONSP (time_stamp
))
1314 requestor_time
= (Time
) cons_to_long (time_stamp
);
1315 else if (INTEGERP (time_stamp
))
1316 requestor_time
= (Time
) XUINT (time_stamp
);
1317 else if (FLOATP (time_stamp
))
1318 requestor_time
= (Time
) XFLOAT_DATA (time_stamp
);
1320 error ("TIME_STAMP must be cons or number");
1325 /* The protected block contains wait_reading_process_output, which
1326 can run random lisp code (process handlers) or signal.
1327 Therefore, we put the x_uncatch_errors call in an unwind. */
1328 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
1329 x_catch_errors (display
);
1331 TRACE2 ("Get selection %s, type %s",
1332 XGetAtomName (display
, type_atom
),
1333 XGetAtomName (display
, target_property
));
1335 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1336 requestor_window
, requestor_time
);
1339 /* Prepare to block until the reply has been read. */
1340 reading_selection_window
= requestor_window
;
1341 reading_which_selection
= selection_atom
;
1342 XSETCAR (reading_selection_reply
, Qnil
);
1344 frame
= some_frame_on_display (dpyinfo
);
1346 /* If the display no longer has frames, we can't expect
1347 to get many more selection requests from it, so don't
1348 bother trying to queue them. */
1351 x_start_queuing_selection_requests ();
1353 record_unwind_protect (queue_selection_requests_unwind
,
1358 /* This allows quits. Also, don't wait forever. */
1359 secs
= x_selection_timeout
/ 1000;
1360 usecs
= (x_selection_timeout
% 1000) * 1000;
1361 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1362 wait_reading_process_output (secs
, usecs
, 0, 0,
1363 reading_selection_reply
, NULL
, 0);
1364 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1367 if (x_had_errors_p (display
))
1368 error ("Cannot get selection");
1369 /* This calls x_uncatch_errors. */
1370 unbind_to (count
, Qnil
);
1373 if (NILP (XCAR (reading_selection_reply
)))
1374 error ("Timed out waiting for reply from selection owner");
1375 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1378 /* Otherwise, the selection is waiting for us on the requested property. */
1380 x_get_window_property_as_lisp_data (display
, requestor_window
,
1381 target_property
, target_type
,
1385 /* Subroutines of x_get_window_property_as_lisp_data */
1387 /* Use xfree, not XFree, to free the data obtained with this function. */
1390 x_get_window_property (Display
*display
, Window window
, Atom property
,
1391 unsigned char **data_ret
, int *bytes_ret
,
1392 Atom
*actual_type_ret
, int *actual_format_ret
,
1393 unsigned long *actual_size_ret
, int delete_p
)
1396 unsigned long bytes_remaining
;
1398 unsigned char *tmp_data
= 0;
1400 int buffer_size
= SELECTION_QUANTUM (display
);
1402 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1403 buffer_size
= MAX_SELECTION_QUANTUM
;
1407 /* First probe the thing to find out how big it is. */
1408 result
= XGetWindowProperty (display
, window
, property
,
1409 0L, 0L, False
, AnyPropertyType
,
1410 actual_type_ret
, actual_format_ret
,
1412 &bytes_remaining
, &tmp_data
);
1413 if (result
!= Success
)
1421 /* This was allocated by Xlib, so use XFree. */
1422 XFree ((char *) tmp_data
);
1424 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1430 total_size
= bytes_remaining
+ 1;
1431 *data_ret
= (unsigned char *) xmalloc (total_size
);
1433 /* Now read, until we've gotten it all. */
1434 while (bytes_remaining
)
1436 #ifdef TRACE_SELECTION
1437 int last
= bytes_remaining
;
1440 = XGetWindowProperty (display
, window
, property
,
1441 (long)offset
/4, (long)buffer_size
/4,
1444 actual_type_ret
, actual_format_ret
,
1445 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1447 TRACE2 ("Read %ld bytes from property %s",
1448 last
- bytes_remaining
,
1449 XGetAtomName (display
, property
));
1451 /* If this doesn't return Success at this point, it means that
1452 some clod deleted the selection while we were in the midst of
1453 reading it. Deal with that, I guess.... */
1454 if (result
!= Success
)
1457 /* The man page for XGetWindowProperty says:
1458 "If the returned format is 32, the returned data is represented
1459 as a long array and should be cast to that type to obtain the
1461 This applies even if long is more than 32 bits, the X library
1462 converts from 32 bit elements received from the X server to long
1463 and passes the long array to us. Thus, for that case memcpy can not
1464 be used. We convert to a 32 bit type here, because so much code
1467 The bytes and offsets passed to XGetWindowProperty refers to the
1468 property and those are indeed in 32 bit quantities if format is 32. */
1470 if (*actual_format_ret
== 32 && *actual_format_ret
< BITS_PER_LONG
)
1473 int *idata
= (int *) ((*data_ret
) + offset
);
1474 long *ldata
= (long *) tmp_data
;
1476 for (i
= 0; i
< *actual_size_ret
; ++i
)
1478 idata
[i
]= (int) ldata
[i
];
1484 *actual_size_ret
*= *actual_format_ret
/ 8;
1485 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1486 offset
+= *actual_size_ret
;
1489 /* This was allocated by Xlib, so use XFree. */
1490 XFree ((char *) tmp_data
);
1495 *bytes_ret
= offset
;
1498 /* Use xfree, not XFree, to free the data obtained with this function. */
1501 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1502 Lisp_Object target_type
,
1503 unsigned int min_size_bytes
,
1504 unsigned char **data_ret
, int *size_bytes_ret
,
1505 Atom
*type_ret
, int *format_ret
,
1506 unsigned long *size_ret
)
1509 struct prop_location
*wait_object
;
1510 *size_bytes_ret
= min_size_bytes
;
1511 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1513 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1515 /* At this point, we have read an INCR property.
1516 Delete the property to ack it.
1517 (But first, prepare to receive the next event in this handshake.)
1519 Now, we must loop, waiting for the sending window to put a value on
1520 that property, then reading the property, then deleting it to ack.
1521 We are done when the sender places a property of length 0.
1524 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1525 TRACE1 (" Delete property %s",
1526 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1527 XDeleteProperty (display
, window
, property
);
1528 TRACE1 (" Expect new value of property %s",
1529 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1530 wait_object
= expect_property_change (display
, window
, property
,
1537 unsigned char *tmp_data
;
1540 TRACE0 (" Wait for property change");
1541 wait_for_property_change (wait_object
);
1543 /* expect it again immediately, because x_get_window_property may
1544 .. no it won't, I don't get it.
1545 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1546 TRACE0 (" Get property value");
1547 x_get_window_property (display
, window
, property
,
1548 &tmp_data
, &tmp_size_bytes
,
1549 type_ret
, format_ret
, size_ret
, 1);
1551 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1553 if (tmp_size_bytes
== 0) /* we're done */
1555 TRACE0 ("Done reading incrementally");
1557 if (! waiting_for_other_props_on_window (display
, window
))
1558 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1559 /* Use xfree, not XFree, because x_get_window_property
1560 calls xmalloc itself. */
1566 TRACE1 (" ACK by deleting property %s",
1567 XGetAtomName (display
, property
));
1568 XDeleteProperty (display
, window
, property
);
1569 wait_object
= expect_property_change (display
, window
, property
,
1574 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1576 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1577 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1580 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1581 offset
+= tmp_size_bytes
;
1583 /* Use xfree, not XFree, because x_get_window_property
1584 calls xmalloc itself. */
1590 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1591 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1592 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1595 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1597 Lisp_Object target_type
,
1598 Atom selection_atom
)
1602 unsigned long actual_size
;
1603 unsigned char *data
= 0;
1606 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1608 TRACE0 ("Reading selection data");
1610 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1611 &actual_type
, &actual_format
, &actual_size
, 1);
1614 int there_is_a_selection_owner
;
1616 there_is_a_selection_owner
1617 = XGetSelectionOwner (display
, selection_atom
);
1619 if (there_is_a_selection_owner
)
1620 signal_error ("Selection owner couldn't convert",
1622 ? list2 (target_type
,
1623 x_atom_to_symbol (display
, actual_type
))
1626 signal_error ("No selection",
1627 x_atom_to_symbol (display
, selection_atom
));
1630 if (actual_type
== dpyinfo
->Xatom_INCR
)
1632 /* That wasn't really the data, just the beginning. */
1634 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1636 /* Use xfree, not XFree, because x_get_window_property
1637 calls xmalloc itself. */
1638 xfree ((char *) data
);
1640 receive_incremental_selection (display
, window
, property
, target_type
,
1641 min_size_bytes
, &data
, &bytes
,
1642 &actual_type
, &actual_format
,
1647 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1648 XDeleteProperty (display
, window
, property
);
1652 /* It's been read. Now convert it to a lisp object in some semi-rational
1654 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1655 actual_type
, actual_format
);
1657 /* Use xfree, not XFree, because x_get_window_property
1658 calls xmalloc itself. */
1659 xfree ((char *) data
);
1663 /* These functions convert from the selection data read from the server into
1664 something that we can use from Lisp, and vice versa.
1666 Type: Format: Size: Lisp Type:
1667 ----- ------- ----- -----------
1670 ATOM 32 > 1 Vector of Symbols
1672 * 16 > 1 Vector of Integers
1673 * 32 1 if <=16 bits: Integer
1674 if > 16 bits: Cons of top16, bot16
1675 * 32 > 1 Vector of the above
1677 When converting a Lisp number to C, it is assumed to be of format 16 if
1678 it is an integer, and of format 32 if it is a cons of two integers.
1680 When converting a vector of numbers from Lisp to C, it is assumed to be
1681 of format 16 if every element in the vector is an integer, and is assumed
1682 to be of format 32 if any element is a cons of two integers.
1684 When converting an object to C, it may be of the form (SYMBOL . <data>)
1685 where SYMBOL is what we should claim that the type is. Format and
1686 representation are as above.
1688 Important: When format is 32, data should contain an array of int,
1689 not an array of long as the X library returns. This makes a difference
1690 when sizeof(long) != sizeof(int). */
1695 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1696 int size
, Atom type
, int format
)
1698 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1700 if (type
== dpyinfo
->Xatom_NULL
)
1703 /* Convert any 8-bit data to a string, for compactness. */
1704 else if (format
== 8)
1706 Lisp_Object str
, lispy_type
;
1708 str
= make_unibyte_string ((char *) data
, size
);
1709 /* Indicate that this string is from foreign selection by a text
1710 property `foreign-selection' so that the caller of
1711 x-get-selection-internal (usually x-get-selection) can know
1712 that the string must be decode. */
1713 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1714 lispy_type
= QCOMPOUND_TEXT
;
1715 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1716 lispy_type
= QUTF8_STRING
;
1718 lispy_type
= QSTRING
;
1719 Fput_text_property (make_number (0), make_number (size
),
1720 Qforeign_selection
, lispy_type
, str
);
1723 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1724 a vector of symbols.
1726 else if (type
== XA_ATOM
)
1729 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1730 But the callers of these function has made sure the data for
1731 format == 32 is an array of int. Thus, use int instead
1733 int *idata
= (int *) data
;
1735 if (size
== sizeof (int))
1736 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1739 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1741 for (i
= 0; i
< size
/ sizeof (int); i
++)
1742 Faset (v
, make_number (i
),
1743 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1748 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1749 If the number is 32 bits and won't fit in a Lisp_Int,
1750 convert it to a cons of integers, 16 bits in each half.
1752 else if (format
== 32 && size
== sizeof (int))
1753 return long_to_cons (((unsigned int *) data
) [0]);
1754 else if (format
== 16 && size
== sizeof (short))
1755 return make_number ((int) (((unsigned short *) data
) [0]));
1757 /* Convert any other kind of data to a vector of numbers, represented
1758 as above (as an integer, or a cons of two 16 bit integers.)
1760 else if (format
== 16)
1764 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1765 for (i
= 0; i
< size
/ 2; i
++)
1767 int j
= (int) ((unsigned short *) data
) [i
];
1768 Faset (v
, make_number (i
), make_number (j
));
1775 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1776 for (i
= 0; i
< size
/ 4; i
++)
1778 unsigned int j
= ((unsigned int *) data
) [i
];
1779 Faset (v
, make_number (i
), long_to_cons (j
));
1786 /* Use xfree, not XFree, to free the data obtained with this function. */
1789 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1790 unsigned char **data_ret
, Atom
*type_ret
,
1791 unsigned int *size_ret
,
1792 int *format_ret
, int *nofree_ret
)
1794 Lisp_Object type
= Qnil
;
1795 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1799 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1803 if (CONSP (obj
) && NILP (XCDR (obj
)))
1807 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1808 { /* This is not the same as declining */
1814 else if (STRINGP (obj
))
1816 if (SCHARS (obj
) < SBYTES (obj
))
1817 /* OBJ is a multibyte string containing a non-ASCII char. */
1818 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1822 *size_ret
= SBYTES (obj
);
1823 *data_ret
= SDATA (obj
);
1826 else if (SYMBOLP (obj
))
1830 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1831 (*data_ret
) [sizeof (Atom
)] = 0;
1832 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1833 if (NILP (type
)) type
= QATOM
;
1835 else if (INTEGERP (obj
)
1836 && XINT (obj
) < 0xFFFF
1837 && XINT (obj
) > -0xFFFF)
1841 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1842 (*data_ret
) [sizeof (short)] = 0;
1843 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1844 if (NILP (type
)) type
= QINTEGER
;
1846 else if (INTEGERP (obj
)
1847 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1848 && (INTEGERP (XCDR (obj
))
1849 || (CONSP (XCDR (obj
))
1850 && INTEGERP (XCAR (XCDR (obj
)))))))
1854 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1855 (*data_ret
) [sizeof (long)] = 0;
1856 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1857 if (NILP (type
)) type
= QINTEGER
;
1859 else if (VECTORP (obj
))
1861 /* Lisp_Vectors may represent a set of ATOMs;
1862 a set of 16 or 32 bit INTEGERs;
1863 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1867 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1868 /* This vector is an ATOM set */
1870 if (NILP (type
)) type
= QATOM
;
1871 *size_ret
= XVECTOR (obj
)->size
;
1873 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1874 for (i
= 0; i
< *size_ret
; i
++)
1875 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1876 (*(Atom
**) data_ret
) [i
]
1877 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1879 signal_error ("All elements of selection vector must have same type", obj
);
1881 #if 0 /* #### MULTIPLE doesn't work yet */
1882 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1883 /* This vector is an ATOM_PAIR set */
1885 if (NILP (type
)) type
= QATOM_PAIR
;
1886 *size_ret
= XVECTOR (obj
)->size
;
1888 *data_ret
= (unsigned char *)
1889 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1890 for (i
= 0; i
< *size_ret
; i
++)
1891 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1893 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1894 if (XVECTOR (pair
)->size
!= 2)
1896 "Elements of the vector must be vectors of exactly two elements",
1899 (*(Atom
**) data_ret
) [i
* 2]
1900 = symbol_to_x_atom (dpyinfo
, display
,
1901 XVECTOR (pair
)->contents
[0]);
1902 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1903 = symbol_to_x_atom (dpyinfo
, display
,
1904 XVECTOR (pair
)->contents
[1]);
1907 signal_error ("All elements of the vector must be of the same type",
1913 /* This vector is an INTEGER set, or something like it */
1916 *size_ret
= XVECTOR (obj
)->size
;
1917 if (NILP (type
)) type
= QINTEGER
;
1919 for (i
= 0; i
< *size_ret
; i
++)
1920 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1922 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1923 signal_error (/* Qselection_error */
1924 "Elements of selection vector must be integers or conses of integers",
1927 /* Use sizeof(long) even if it is more than 32 bits. See comment
1928 in x_get_window_property and x_fill_property_data. */
1930 if (*format_ret
== 32) data_size
= sizeof(long);
1931 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1932 for (i
= 0; i
< *size_ret
; i
++)
1933 if (*format_ret
== 32)
1934 (*((unsigned long **) data_ret
)) [i
]
1935 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1937 (*((unsigned short **) data_ret
)) [i
]
1938 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1942 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1944 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1948 clean_local_selection_data (Lisp_Object obj
)
1951 && INTEGERP (XCAR (obj
))
1952 && CONSP (XCDR (obj
))
1953 && INTEGERP (XCAR (XCDR (obj
)))
1954 && NILP (XCDR (XCDR (obj
))))
1955 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1958 && INTEGERP (XCAR (obj
))
1959 && INTEGERP (XCDR (obj
)))
1961 if (XINT (XCAR (obj
)) == 0)
1963 if (XINT (XCAR (obj
)) == -1)
1964 return make_number (- XINT (XCDR (obj
)));
1969 int size
= XVECTOR (obj
)->size
;
1972 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1973 copy
= Fmake_vector (make_number (size
), Qnil
);
1974 for (i
= 0; i
< size
; i
++)
1975 XVECTOR (copy
)->contents
[i
]
1976 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1982 /* Called from XTread_socket to handle SelectionNotify events.
1983 If it's the selection we are waiting for, stop waiting
1984 by setting the car of reading_selection_reply to non-nil.
1985 We store t there if the reply is successful, lambda if not. */
1988 x_handle_selection_notify (XSelectionEvent
*event
)
1990 if (event
->requestor
!= reading_selection_window
)
1992 if (event
->selection
!= reading_which_selection
)
1995 TRACE0 ("Received SelectionNotify");
1996 XSETCAR (reading_selection_reply
,
1997 (event
->property
!= 0 ? Qt
: Qlambda
));
2001 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2002 Sx_own_selection_internal
, 2, 2, 0,
2003 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2004 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2005 \(Those are literal upper-case symbol names, since that's what X expects.)
2006 VALUE is typically a string, or a cons of two markers, but may be
2007 anything that the functions on `selection-converter-alist' know about. */)
2008 (Lisp_Object selection_name
, Lisp_Object selection_value
)
2011 CHECK_SYMBOL (selection_name
);
2012 if (NILP (selection_value
)) error ("SELECTION-VALUE may not be nil");
2013 x_own_selection (selection_name
, selection_value
);
2014 return selection_value
;
2018 /* Request the selection value from the owner. If we are the owner,
2019 simply return our selection value. If we are not the owner, this
2020 will block until all of the data has arrived. */
2022 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2023 Sx_get_selection_internal
, 2, 3, 0,
2024 doc
: /* Return text selected from some X window.
2025 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2026 \(Those are literal upper-case symbol names, since that's what X expects.)
2027 TYPE is the type of data desired, typically `STRING'.
2028 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2029 selections. If omitted, defaults to the time for the last event. */)
2030 (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
2032 Lisp_Object val
= Qnil
;
2033 struct gcpro gcpro1
, gcpro2
;
2034 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2036 CHECK_SYMBOL (selection_symbol
);
2038 #if 0 /* #### MULTIPLE doesn't work yet */
2039 if (CONSP (target_type
)
2040 && XCAR (target_type
) == QMULTIPLE
)
2042 CHECK_VECTOR (XCDR (target_type
));
2043 /* So we don't destructively modify this... */
2044 target_type
= copy_multiple_data (target_type
);
2048 CHECK_SYMBOL (target_type
);
2050 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2054 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2059 && SYMBOLP (XCAR (val
)))
2062 if (CONSP (val
) && NILP (XCDR (val
)))
2065 val
= clean_local_selection_data (val
);
2071 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2072 Sx_disown_selection_internal
, 1, 2, 0,
2073 doc
: /* If we own the selection SELECTION, disown it.
2074 Disowning it means there is no such selection. */)
2075 (Lisp_Object selection
, Lisp_Object time
)
2078 Atom selection_atom
;
2080 struct selection_input_event sie
;
2081 struct input_event ie
;
2084 struct x_display_info
*dpyinfo
;
2085 struct frame
*sf
= SELECTED_FRAME ();
2088 if (! FRAME_X_P (sf
))
2091 display
= FRAME_X_DISPLAY (sf
);
2092 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2093 CHECK_SYMBOL (selection
);
2095 timestamp
= last_event_timestamp
;
2097 timestamp
= cons_to_long (time
);
2099 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2100 return Qnil
; /* Don't disown the selection when we're not the owner. */
2102 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2105 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2108 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2109 generated for a window which owns the selection when that window sets
2110 the selection owner to None. The NCD server does, the MIT Sun4 server
2111 doesn't. So we synthesize one; this means we might get two, but
2112 that's ok, because the second one won't have any effect. */
2113 SELECTION_EVENT_DISPLAY (&event
.sie
) = display
;
2114 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2115 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2116 x_handle_selection_clear (&event
.ie
);
2121 /* Get rid of all the selections in buffer BUFFER.
2122 This is used when we kill a buffer. */
2125 x_disown_buffer_selections (Lisp_Object buffer
)
2128 struct buffer
*buf
= XBUFFER (buffer
);
2130 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2132 Lisp_Object elt
, value
;
2135 if (CONSP (value
) && MARKERP (XCAR (value
))
2136 && XMARKER (XCAR (value
))->buffer
== buf
)
2137 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2141 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2143 doc
: /* Whether the current Emacs process owns the given X Selection.
2144 The arg should be the name of the selection in question, typically one of
2145 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2146 \(Those are literal upper-case symbol names, since that's what X expects.)
2147 For convenience, the symbol nil is the same as `PRIMARY',
2148 and t is the same as `SECONDARY'. */)
2149 (Lisp_Object selection
)
2152 CHECK_SYMBOL (selection
);
2153 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2154 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2156 if (NILP (Fassq (selection
, Vselection_alist
)))
2161 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2163 doc
: /* Whether there is an owner for the given X Selection.
2164 The arg should be the name of the selection in question, typically one of
2165 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2166 \(Those are literal upper-case symbol names, since that's what X expects.)
2167 For convenience, the symbol nil is the same as `PRIMARY',
2168 and t is the same as `SECONDARY'. */)
2169 (Lisp_Object selection
)
2174 struct frame
*sf
= SELECTED_FRAME ();
2176 /* It should be safe to call this before we have an X frame. */
2177 if (! FRAME_X_P (sf
))
2180 dpy
= FRAME_X_DISPLAY (sf
);
2181 CHECK_SYMBOL (selection
);
2182 if (!NILP (Fx_selection_owner_p (selection
)))
2184 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2185 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2186 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2190 owner
= XGetSelectionOwner (dpy
, atom
);
2192 return (owner
? Qt
: Qnil
);
2196 /***********************************************************************
2197 Drag and drop support
2198 ***********************************************************************/
2199 /* Check that lisp values are of correct type for x_fill_property_data.
2200 That is, number, string or a cons with two numbers (low and high 16
2201 bit parts of a 32 bit number). */
2204 x_check_property_data (Lisp_Object data
)
2209 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2211 Lisp_Object o
= XCAR (iter
);
2213 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2215 else if (CONSP (o
) &&
2216 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2223 /* Convert lisp values to a C array. Values may be a number, a string
2224 which is taken as an X atom name and converted to the atom value, or
2225 a cons containing the two 16 bit parts of a 32 bit number.
2227 DPY is the display use to look up X atoms.
2228 DATA is a Lisp list of values to be converted.
2229 RET is the C array that contains the converted values. It is assumed
2230 it is big enough to hold all values.
2231 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2232 be stored in RET. Note that long is used for 32 even if long is more
2233 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2234 XClientMessageEvent). */
2237 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2240 long *d32
= (long *) ret
;
2241 short *d16
= (short *) ret
;
2242 char *d08
= (char *) ret
;
2245 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2247 Lisp_Object o
= XCAR (iter
);
2250 val
= (long) XFASTINT (o
);
2251 else if (FLOATP (o
))
2252 val
= (long) XFLOAT_DATA (o
);
2254 val
= (long) cons_to_long (o
);
2255 else if (STRINGP (o
))
2258 val
= (long) XInternAtom (dpy
, (char *) SDATA (o
), False
);
2262 error ("Wrong type, must be string, number or cons");
2265 *d08
++ = (char) val
;
2266 else if (format
== 16)
2267 *d16
++ = (short) val
;
2273 /* Convert an array of C values to a Lisp list.
2274 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2275 DATA is a C array of values to be converted.
2276 TYPE is the type of the data. Only XA_ATOM is special, it converts
2277 each number in DATA to its corresponfing X atom as a symbol.
2278 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2280 SIZE is the number of elements in DATA.
2282 Important: When format is 32, data should contain an array of int,
2283 not an array of long as the X library returns. This makes a difference
2284 when sizeof(long) != sizeof(int).
2286 Also see comment for selection_data_to_lisp_data above. */
2289 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2290 Atom type
, int format
, long unsigned int size
)
2292 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2293 data
, size
*format
/8, type
, format
);
2296 /* Get the mouse position in frame relative coordinates. */
2299 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2301 Window root
, dummy_window
;
2306 XQueryPointer (FRAME_X_DISPLAY (f
),
2307 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2309 /* The root window which contains the pointer. */
2312 /* Window pointer is on, not used */
2315 /* The position on that root window. */
2318 /* x/y in dummy_window coordinates, not used. */
2321 /* Modifier keys and pointer buttons, about which
2323 (unsigned int *) &dummy
);
2326 /* Absolute to relative. */
2327 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2328 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2333 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2334 Sx_get_atom_name
, 1, 2, 0,
2335 doc
: /* Return the X atom name for VALUE as a string.
2336 VALUE may be a number or a cons where the car is the upper 16 bits and
2337 the cdr is the lower 16 bits of a 32 bit value.
2338 Use the display for FRAME or the current frame if FRAME is not given or nil.
2340 If the value is 0 or the atom is not known, return the empty string. */)
2341 (Lisp_Object value
, Lisp_Object frame
)
2343 struct frame
*f
= check_x_frame (frame
);
2346 Lisp_Object ret
= Qnil
;
2347 Display
*dpy
= FRAME_X_DISPLAY (f
);
2351 if (INTEGERP (value
))
2352 atom
= (Atom
) XUINT (value
);
2353 else if (FLOATP (value
))
2354 atom
= (Atom
) XFLOAT_DATA (value
);
2355 else if (CONSP (value
))
2356 atom
= (Atom
) cons_to_long (value
);
2358 error ("Wrong type, value must be number or cons");
2361 x_catch_errors (dpy
);
2362 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2363 had_errors
= x_had_errors_p (dpy
);
2364 x_uncatch_errors ();
2367 ret
= make_string (name
, strlen (name
));
2369 if (atom
&& name
) XFree (name
);
2370 if (NILP (ret
)) ret
= empty_unibyte_string
;
2377 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2378 Sx_register_dnd_atom
, 1, 2, 0,
2379 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2380 ATOM can be a symbol or a string. The ATOM is interned on the display that
2381 FRAME is on. If FRAME is nil, the selected frame is used. */)
2382 (Lisp_Object atom
, Lisp_Object frame
)
2385 struct frame
*f
= check_x_frame (frame
);
2387 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2391 x_atom
= symbol_to_x_atom (dpyinfo
, FRAME_X_DISPLAY (f
), atom
);
2392 else if (STRINGP (atom
))
2395 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), (char *) SDATA (atom
), False
);
2399 error ("ATOM must be a symbol or a string");
2401 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2402 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2405 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2407 dpyinfo
->x_dnd_atoms_size
*= 2;
2408 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2409 sizeof (*dpyinfo
->x_dnd_atoms
)
2410 * dpyinfo
->x_dnd_atoms_size
);
2413 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2417 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2420 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2424 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2425 unsigned long size
= 160/event
->format
;
2427 unsigned char *data
= (unsigned char *) event
->data
.b
;
2431 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2432 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2434 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2436 XSETFRAME (frame
, f
);
2438 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2439 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2440 function expects them to be of size int (i.e. 32). So to be able to
2441 use that function, put the data in the form it expects if format is 32. */
2443 if (event
->format
== 32 && event
->format
< BITS_PER_LONG
)
2446 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2447 idata
[i
] = (int) event
->data
.l
[i
];
2448 data
= (unsigned char *) idata
;
2451 vec
= Fmake_vector (make_number (4), Qnil
);
2452 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2453 event
->message_type
)));
2454 ASET (vec
, 1, frame
);
2455 ASET (vec
, 2, make_number (event
->format
));
2456 ASET (vec
, 3, x_property_data_to_lisp (f
,
2458 event
->message_type
,
2462 mouse_position_for_drop (f
, &x
, &y
);
2463 bufp
->kind
= DRAG_N_DROP_EVENT
;
2464 bufp
->frame_or_window
= frame
;
2465 bufp
->timestamp
= CurrentTime
;
2466 bufp
->x
= make_number (x
);
2467 bufp
->y
= make_number (y
);
2469 bufp
->modifiers
= 0;
2474 DEFUN ("x-send-client-message", Fx_send_client_event
,
2475 Sx_send_client_message
, 6, 6, 0,
2476 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2478 For DISPLAY, specify either a frame or a display name (a string).
2479 If DISPLAY is nil, that stands for the selected frame's display.
2480 DEST may be a number, in which case it is a Window id. The value 0 may
2481 be used to send to the root window of the DISPLAY.
2482 If DEST is a cons, it is converted to a 32 bit number
2483 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2484 number is then used as a window id.
2485 If DEST is a frame the event is sent to the outer window of that frame.
2486 A value of nil means the currently selected frame.
2487 If DEST is the string "PointerWindow" the event is sent to the window that
2488 contains the pointer. If DEST is the string "InputFocus" the event is
2489 sent to the window that has the input focus.
2490 FROM is the frame sending the event. Use nil for currently selected frame.
2491 MESSAGE-TYPE is the name of an Atom as a string.
2492 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2493 bits. VALUES is a list of numbers, cons and/or strings containing the values
2494 to send. If a value is a string, it is converted to an Atom and the value of
2495 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2496 with the high 16 bits from the car and the lower 16 bit from the cdr.
2497 If more values than fits into the event is given, the excessive values
2499 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2501 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2503 CHECK_STRING (message_type
);
2504 x_send_client_event(display
, dest
, from
,
2505 XInternAtom (dpyinfo
->display
,
2506 SDATA (message_type
),
2514 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2516 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2519 struct frame
*f
= check_x_frame (from
);
2522 CHECK_NUMBER (format
);
2523 CHECK_CONS (values
);
2525 if (x_check_property_data (values
) == -1)
2526 error ("Bad data in VALUES, must be number, cons or string");
2528 event
.xclient
.type
= ClientMessage
;
2529 event
.xclient
.format
= XFASTINT (format
);
2531 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2532 && event
.xclient
.format
!= 32)
2533 error ("FORMAT must be one of 8, 16 or 32");
2535 if (FRAMEP (dest
) || NILP (dest
))
2537 struct frame
*fdest
= check_x_frame (dest
);
2538 wdest
= FRAME_OUTER_WINDOW (fdest
);
2540 else if (STRINGP (dest
))
2542 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2543 wdest
= PointerWindow
;
2544 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2547 error ("DEST as a string must be one of PointerWindow or InputFocus");
2549 else if (INTEGERP (dest
))
2550 wdest
= (Window
) XFASTINT (dest
);
2551 else if (FLOATP (dest
))
2552 wdest
= (Window
) XFLOAT_DATA (dest
);
2553 else if (CONSP (dest
))
2555 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2556 error ("Both car and cdr for DEST must be numbers");
2558 wdest
= (Window
) cons_to_long (dest
);
2561 error ("DEST must be a frame, nil, string, number or cons");
2563 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2564 to_root
= wdest
== dpyinfo
->root_window
;
2568 event
.xclient
.message_type
= message_type
;
2569 event
.xclient
.display
= dpyinfo
->display
;
2571 /* Some clients (metacity for example) expects sending window to be here
2572 when sending to the root window. */
2573 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2576 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2577 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2578 event
.xclient
.format
);
2580 /* If event mask is 0 the event is sent to the client that created
2581 the destination window. But if we are sending to the root window,
2582 there is no such client. Then we set the event mask to 0xffff. The
2583 event then goes to clients selecting for events on the root window. */
2584 x_catch_errors (dpyinfo
->display
);
2586 int propagate
= to_root
? False
: True
;
2587 unsigned mask
= to_root
? 0xffff : 0;
2588 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2589 XFlush (dpyinfo
->display
);
2591 x_uncatch_errors ();
2597 syms_of_xselect (void)
2599 defsubr (&Sx_get_selection_internal
);
2600 defsubr (&Sx_own_selection_internal
);
2601 defsubr (&Sx_disown_selection_internal
);
2602 defsubr (&Sx_selection_owner_p
);
2603 defsubr (&Sx_selection_exists_p
);
2605 defsubr (&Sx_get_atom_name
);
2606 defsubr (&Sx_send_client_message
);
2607 defsubr (&Sx_register_dnd_atom
);
2609 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2610 staticpro (&reading_selection_reply
);
2611 reading_selection_window
= 0;
2612 reading_which_selection
= 0;
2614 property_change_wait_list
= 0;
2615 prop_location_identifier
= 0;
2616 property_change_reply
= Fcons (Qnil
, Qnil
);
2617 staticpro (&property_change_reply
);
2619 Vselection_alist
= Qnil
;
2620 staticpro (&Vselection_alist
);
2622 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2623 doc
: /* An alist associating X Windows selection-types with functions.
2624 These functions are called to convert the selection, with three args:
2625 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2626 a desired type to which the selection should be converted;
2627 and the local selection value (whatever was given to `x-own-selection').
2629 The function should return the value to send to the X server
2630 \(typically a string). A return value of nil
2631 means that the conversion could not be done.
2632 A return value which is the symbol `NULL'
2633 means that a side-effect was executed,
2634 and there is no meaningful selection value. */);
2635 Vselection_converter_alist
= Qnil
;
2637 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2638 doc
: /* A list of functions to be called when Emacs loses an X selection.
2639 \(This happens when some other X client makes its own selection
2640 or when a Lisp program explicitly clears the selection.)
2641 The functions are called with one argument, the selection type
2642 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2643 Vx_lost_selection_functions
= Qnil
;
2645 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2646 doc
: /* A list of functions to be called when Emacs answers a selection request.
2647 The functions are called with four arguments:
2648 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2649 - the selection-type which Emacs was asked to convert the
2650 selection into before sending (for example, `STRING' or `LENGTH');
2651 - a flag indicating success or failure for responding to the request.
2652 We might have failed (and declined the request) for any number of reasons,
2653 including being asked for a selection that we no longer own, or being asked
2654 to convert into a type that we don't know about or that is inappropriate.
2655 This hook doesn't let you change the behavior of Emacs's selection replies,
2656 it merely informs you that they have happened. */);
2657 Vx_sent_selection_functions
= Qnil
;
2659 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2660 doc
: /* Number of milliseconds to wait for a selection reply.
2661 If the selection owner doesn't reply in this time, we give up.
2662 A value of 0 means wait as long as necessary. This is initialized from the
2663 \"*selectionTimeout\" resource. */);
2664 x_selection_timeout
= 0;
2666 /* QPRIMARY is defined in keyboard.c. */
2667 QSECONDARY
= intern_c_string ("SECONDARY"); staticpro (&QSECONDARY
);
2668 QSTRING
= intern_c_string ("STRING"); staticpro (&QSTRING
);
2669 QINTEGER
= intern_c_string ("INTEGER"); staticpro (&QINTEGER
);
2670 QCLIPBOARD
= intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2671 QTIMESTAMP
= intern_c_string ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2672 QTEXT
= intern_c_string ("TEXT"); staticpro (&QTEXT
);
2673 QCOMPOUND_TEXT
= intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2674 QUTF8_STRING
= intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2675 QDELETE
= intern_c_string ("DELETE"); staticpro (&QDELETE
);
2676 QMULTIPLE
= intern_c_string ("MULTIPLE"); staticpro (&QMULTIPLE
);
2677 QINCR
= intern_c_string ("INCR"); staticpro (&QINCR
);
2678 QEMACS_TMP
= intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2679 QTARGETS
= intern_c_string ("TARGETS"); staticpro (&QTARGETS
);
2680 QATOM
= intern_c_string ("ATOM"); staticpro (&QATOM
);
2681 QATOM_PAIR
= intern_c_string ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2682 QNULL
= intern_c_string ("NULL"); staticpro (&QNULL
);
2683 Qcompound_text_with_extensions
= intern_c_string ("compound-text-with-extensions");
2684 staticpro (&Qcompound_text_with_extensions
);
2686 Qforeign_selection
= intern_c_string ("foreign-selection");
2687 staticpro (&Qforeign_selection
);