1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Rewritten by jwz */
23 #include <stdio.h> /* termhooks.h needs this */
26 #ifdef HAVE_SYS_TYPES_H
27 #include <sys/types.h>
33 #include "xterm.h" /* for all of the X includes */
34 #include "dispextern.h" /* frame.h seems to want this */
35 #include "frame.h" /* Need this to get the X window of selected_frame */
36 #include "blockinput.h"
39 #include "termhooks.h"
42 #include <X11/Xproto.h>
46 static Lisp_Object
x_atom_to_symbol (Display
*dpy
, Atom atom
);
47 static Atom
symbol_to_x_atom (struct x_display_info
*, Display
*,
49 static void x_own_selection (Lisp_Object
, Lisp_Object
);
50 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int);
51 static void x_decline_selection_request (struct input_event
*);
52 static Lisp_Object
x_selection_request_lisp_error (Lisp_Object
);
53 static Lisp_Object
queue_selection_requests_unwind (Lisp_Object
);
54 static Lisp_Object
some_frame_on_display (struct x_display_info
*);
55 static Lisp_Object
x_catch_errors_unwind (Lisp_Object
);
56 static void x_reply_selection_request (struct input_event
*, int,
57 unsigned char *, int, Atom
);
58 static int waiting_for_other_props_on_window (Display
*, Window
);
59 static struct prop_location
*expect_property_change (Display
*, Window
,
61 static void unexpect_property_change (struct prop_location
*);
62 static Lisp_Object
wait_for_property_change_unwind (Lisp_Object
);
63 static void wait_for_property_change (struct prop_location
*);
64 static Lisp_Object
x_get_foreign_selection (Lisp_Object
,
67 static void x_get_window_property (Display
*, Window
, Atom
,
68 unsigned char **, int *,
69 Atom
*, int *, unsigned long *, int);
70 static void receive_incremental_selection (Display
*, Window
, Atom
,
71 Lisp_Object
, unsigned,
72 unsigned char **, int *,
73 Atom
*, int *, unsigned long *);
74 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
77 static Lisp_Object
selection_data_to_lisp_data (Display
*,
78 const unsigned char *,
80 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
81 unsigned char **, Atom
*,
82 unsigned *, int *, int *);
83 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
85 /* Printing traces to stderr. */
87 #ifdef TRACE_SELECTION
89 fprintf (stderr, "%d: " fmt "\n", getpid ())
90 #define TRACE1(fmt, a0) \
91 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
92 #define TRACE2(fmt, a0, a1) \
93 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
94 #define TRACE3(fmt, a0, a1, a2) \
95 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
97 #define TRACE0(fmt) (void) 0
98 #define TRACE1(fmt, a0) (void) 0
99 #define TRACE2(fmt, a0, a1) (void) 0
103 Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
104 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
107 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
108 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
110 Lisp_Object Qcompound_text_with_extensions
;
112 static Lisp_Object Qforeign_selection
;
114 /* If this is a smaller number than the max-request-size of the display,
115 emacs will use INCR selection transfer when the selection is larger
116 than this. The max-request-size is usually around 64k, so if you want
117 emacs to use incremental selection transfers when the selection is
118 smaller than that, set this. I added this mostly for debugging the
119 incremental transfer stuff, but it might improve server performance. */
120 #define MAX_SELECTION_QUANTUM 0xFFFFFF
122 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
124 /* The timestamp of the last input event Emacs received from the X server. */
125 /* Defined in keyboard.c. */
126 extern unsigned long last_event_timestamp
;
128 /* This is an association list whose elements are of the form
129 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
130 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
131 SELECTION-VALUE is the value that emacs owns for that selection.
132 It may be any kind of Lisp object.
133 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
134 as a cons of two 16-bit numbers (making a 32 bit time.)
135 FRAME is the frame for which we made the selection.
136 If there is an entry in this alist, then it can be assumed that Emacs owns
138 The only (eq) parts of this list that are visible from Lisp are the
140 static Lisp_Object Vselection_alist
;
144 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
147 struct selection_event_queue
149 struct input_event event
;
150 struct selection_event_queue
*next
;
153 static struct selection_event_queue
*selection_queue
;
155 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
157 static int x_queue_selection_requests
;
159 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
162 x_queue_event (struct input_event
*event
)
164 struct selection_event_queue
*queue_tmp
;
166 /* Don't queue repeated requests.
167 This only happens for large requests which uses the incremental protocol. */
168 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
170 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
172 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
173 x_decline_selection_request (event
);
179 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
181 if (queue_tmp
!= NULL
)
183 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
184 queue_tmp
->event
= *event
;
185 queue_tmp
->next
= selection_queue
;
186 selection_queue
= queue_tmp
;
190 /* Start queuing SELECTION_REQUEST_EVENT events. */
193 x_start_queuing_selection_requests (void)
195 if (x_queue_selection_requests
)
198 x_queue_selection_requests
++;
199 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
202 /* Stop queuing SELECTION_REQUEST_EVENT events. */
205 x_stop_queuing_selection_requests (void)
207 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
208 --x_queue_selection_requests
;
210 /* Take all the queued events and put them back
211 so that they get processed afresh. */
213 while (selection_queue
!= NULL
)
215 struct selection_event_queue
*queue_tmp
= selection_queue
;
216 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp
);
217 kbd_buffer_unget_event (&queue_tmp
->event
);
218 selection_queue
= queue_tmp
->next
;
219 xfree ((char *)queue_tmp
);
224 /* This converts a Lisp symbol to a server Atom, avoiding a server
225 roundtrip whenever possible. */
228 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Display
*display
, Lisp_Object sym
)
231 if (NILP (sym
)) return 0;
232 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
233 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
234 if (EQ (sym
, QSTRING
)) return XA_STRING
;
235 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
236 if (EQ (sym
, QATOM
)) return XA_ATOM
;
237 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
238 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
239 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
240 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
241 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
242 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
243 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
244 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
245 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
246 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
247 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
248 if (!SYMBOLP (sym
)) abort ();
250 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
252 val
= XInternAtom (display
, SSDATA (SYMBOL_NAME (sym
)), False
);
258 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
259 and calls to intern whenever possible. */
262 x_atom_to_symbol (Display
*dpy
, Atom atom
)
264 struct x_display_info
*dpyinfo
;
285 dpyinfo
= x_display_info_for_display (dpy
);
286 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
288 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
290 if (atom
== dpyinfo
->Xatom_TEXT
)
292 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
293 return QCOMPOUND_TEXT
;
294 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
296 if (atom
== dpyinfo
->Xatom_DELETE
)
298 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
300 if (atom
== dpyinfo
->Xatom_INCR
)
302 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
304 if (atom
== dpyinfo
->Xatom_TARGETS
)
306 if (atom
== dpyinfo
->Xatom_NULL
)
310 str
= XGetAtomName (dpy
, atom
);
312 TRACE1 ("XGetAtomName --> %s", str
);
313 if (! str
) return Qnil
;
316 /* This was allocated by Xlib, so use XFree. */
322 /* Do protocol to assert ourself as a selection owner.
323 Update the Vselection_alist so that we can reply to later requests for
327 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
)
329 struct frame
*sf
= SELECTED_FRAME ();
330 Window selecting_window
;
332 Time timestamp
= last_event_timestamp
;
334 struct x_display_info
*dpyinfo
;
336 if (! FRAME_X_P (sf
))
339 selecting_window
= FRAME_X_WINDOW (sf
);
340 display
= FRAME_X_DISPLAY (sf
);
341 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
343 CHECK_SYMBOL (selection_name
);
344 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
347 x_catch_errors (display
);
348 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
349 x_check_errors (display
, "Can't set selection: %s");
353 /* Now update the local cache */
355 Lisp_Object selection_time
;
356 Lisp_Object selection_data
;
357 Lisp_Object prev_value
;
359 selection_time
= long_to_cons ((unsigned long) timestamp
);
360 selection_data
= list4 (selection_name
, selection_value
,
361 selection_time
, selected_frame
);
362 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
364 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
366 /* If we already owned the selection, remove the old selection data.
367 Perhaps we should destructively modify it instead.
368 Don't use Fdelq as that may QUIT. */
369 if (!NILP (prev_value
))
371 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
372 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
373 if (EQ (prev_value
, Fcar (XCDR (rest
))))
375 XSETCDR (rest
, Fcdr (XCDR (rest
)));
382 /* Given a selection-name and desired type, look up our local copy of
383 the selection value and convert it to the type.
384 The value is nil or a string.
385 This function is used both for remote requests (LOCAL_REQUEST is zero)
386 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
388 This calls random Lisp code, and may signal or gc. */
391 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, int local_request
)
393 Lisp_Object local_value
;
394 Lisp_Object handler_fn
, value
, type
, check
;
397 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
399 if (NILP (local_value
)) return Qnil
;
401 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
402 if (EQ (target_type
, QTIMESTAMP
))
405 value
= XCAR (XCDR (XCDR (local_value
)));
408 else if (EQ (target_type
, QDELETE
))
411 Fx_disown_selection_internal
413 XCAR (XCDR (XCDR (local_value
))));
418 #if 0 /* #### MULTIPLE doesn't work yet */
419 else if (CONSP (target_type
)
420 && XCAR (target_type
) == QMULTIPLE
)
425 pairs
= XCDR (target_type
);
426 size
= XVECTOR (pairs
)->size
;
427 /* If the target is MULTIPLE, then target_type looks like
428 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
429 We modify the second element of each pair in the vector and
430 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
432 for (i
= 0; i
< size
; i
++)
435 pair
= XVECTOR (pairs
)->contents
[i
];
436 XVECTOR (pair
)->contents
[1]
437 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
438 XVECTOR (pair
)->contents
[1],
446 /* Don't allow a quit within the converter.
447 When the user types C-g, he would be surprised
448 if by luck it came during a converter. */
449 count
= SPECPDL_INDEX ();
450 specbind (Qinhibit_quit
, Qt
);
452 CHECK_SYMBOL (target_type
);
453 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
454 /* gcpro is not needed here since nothing but HANDLER_FN
455 is live, and that ought to be a symbol. */
457 if (!NILP (handler_fn
))
458 value
= call3 (handler_fn
,
459 selection_symbol
, (local_request
? Qnil
: target_type
),
460 XCAR (XCDR (local_value
)));
463 unbind_to (count
, Qnil
);
466 /* Make sure this value is of a type that we could transmit
467 to another X client. */
471 && SYMBOLP (XCAR (value
)))
473 check
= XCDR (value
);
481 /* Check for a value that cons_to_long could handle. */
482 else if (CONSP (check
)
483 && INTEGERP (XCAR (check
))
484 && (INTEGERP (XCDR (check
))
486 (CONSP (XCDR (check
))
487 && INTEGERP (XCAR (XCDR (check
)))
488 && NILP (XCDR (XCDR (check
))))))
491 signal_error ("Invalid data returned by selection-conversion function",
492 list2 (handler_fn
, value
));
495 /* Subroutines of x_reply_selection_request. */
497 /* Send a SelectionNotify event to the requestor with property=None,
498 meaning we were unable to do what they wanted. */
501 x_decline_selection_request (struct input_event
*event
)
503 XSelectionEvent reply
;
505 reply
.type
= SelectionNotify
;
506 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
507 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
508 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
509 reply
.time
= SELECTION_EVENT_TIME (event
);
510 reply
.target
= SELECTION_EVENT_TARGET (event
);
511 reply
.property
= None
;
513 /* The reason for the error may be that the receiver has
514 died in the meantime. Handle that case. */
516 x_catch_errors (reply
.display
);
517 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
518 XFlush (reply
.display
);
523 /* This is the selection request currently being processed.
524 It is set to zero when the request is fully processed. */
525 static struct input_event
*x_selection_current_request
;
527 /* Display info in x_selection_request. */
529 static struct x_display_info
*selection_request_dpyinfo
;
531 /* Used as an unwind-protect clause so that, if a selection-converter signals
532 an error, we tell the requester that we were unable to do what they wanted
533 before we throw to top-level or go into the debugger or whatever. */
536 x_selection_request_lisp_error (Lisp_Object ignore
)
538 if (x_selection_current_request
!= 0
539 && selection_request_dpyinfo
->display
)
540 x_decline_selection_request (x_selection_current_request
);
545 x_catch_errors_unwind (Lisp_Object dummy
)
554 /* This stuff is so that INCR selections are reentrant (that is, so we can
555 be servicing multiple INCR selection requests simultaneously.) I haven't
556 actually tested that yet. */
558 /* Keep a list of the property changes that are awaited. */
568 struct prop_location
*next
;
571 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
572 static void wait_for_property_change (struct prop_location
*location
);
573 static void unexpect_property_change (struct prop_location
*location
);
574 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
576 static int prop_location_identifier
;
578 static Lisp_Object property_change_reply
;
580 static struct prop_location
*property_change_reply_object
;
582 static struct prop_location
*property_change_wait_list
;
585 queue_selection_requests_unwind (Lisp_Object tem
)
587 x_stop_queuing_selection_requests ();
591 /* Return some frame whose display info is DPYINFO.
592 Return nil if there is none. */
595 some_frame_on_display (struct x_display_info
*dpyinfo
)
597 Lisp_Object list
, frame
;
599 FOR_EACH_FRAME (list
, frame
)
601 if (FRAME_X_P (XFRAME (frame
))
602 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
609 /* Send the reply to a selection request event EVENT.
610 TYPE is the type of selection data requested.
611 DATA and SIZE describe the data to send, already converted.
612 FORMAT is the unit-size (in bits) of the data to be transmitted. */
614 #ifdef TRACE_SELECTION
615 static int x_reply_selection_request_cnt
;
616 #endif /* TRACE_SELECTION */
619 x_reply_selection_request (struct input_event
*event
, int format
, unsigned char *data
, int size
, Atom type
)
621 XSelectionEvent reply
;
622 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
623 Window window
= SELECTION_EVENT_REQUESTOR (event
);
625 int format_bytes
= format
/8;
626 int max_bytes
= SELECTION_QUANTUM (display
);
627 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
628 int count
= SPECPDL_INDEX ();
630 if (max_bytes
> MAX_SELECTION_QUANTUM
)
631 max_bytes
= MAX_SELECTION_QUANTUM
;
633 reply
.type
= SelectionNotify
;
634 reply
.display
= display
;
635 reply
.requestor
= window
;
636 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
637 reply
.time
= SELECTION_EVENT_TIME (event
);
638 reply
.target
= SELECTION_EVENT_TARGET (event
);
639 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
640 if (reply
.property
== None
)
641 reply
.property
= reply
.target
;
644 /* The protected block contains wait_for_property_change, which can
645 run random lisp code (process handlers) or signal. Therefore, we
646 put the x_uncatch_errors call in an unwind. */
647 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
648 x_catch_errors (display
);
650 #ifdef TRACE_SELECTION
652 char *sel
= XGetAtomName (display
, reply
.selection
);
653 char *tgt
= XGetAtomName (display
, reply
.target
);
654 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++x_reply_selection_request_cnt
);
655 if (sel
) XFree (sel
);
656 if (tgt
) XFree (tgt
);
658 #endif /* TRACE_SELECTION */
660 /* Store the data on the requested property.
661 If the selection is large, only store the first N bytes of it.
663 bytes_remaining
= size
* format_bytes
;
664 if (bytes_remaining
<= max_bytes
)
666 /* Send all the data at once, with minimal handshaking. */
667 TRACE1 ("Sending all %d bytes", bytes_remaining
);
668 XChangeProperty (display
, window
, reply
.property
, type
, format
,
669 PropModeReplace
, data
, size
);
670 /* At this point, the selection was successfully stored; ack it. */
671 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
675 /* Send an INCR selection. */
676 struct prop_location
*wait_object
;
680 frame
= some_frame_on_display (dpyinfo
);
682 /* If the display no longer has frames, we can't expect
683 to get many more selection requests from it, so don't
684 bother trying to queue them. */
687 x_start_queuing_selection_requests ();
689 record_unwind_protect (queue_selection_requests_unwind
,
693 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
694 error ("Attempt to transfer an INCR to ourself!");
696 TRACE2 ("Start sending %d bytes incrementally (%s)",
697 bytes_remaining
, XGetAtomName (display
, reply
.property
));
698 wait_object
= expect_property_change (display
, window
, reply
.property
,
701 TRACE1 ("Set %s to number of bytes to send",
702 XGetAtomName (display
, reply
.property
));
704 /* XChangeProperty expects an array of long even if long is more than
708 value
[0] = bytes_remaining
;
709 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
711 (unsigned char *) value
, 1);
714 XSelectInput (display
, window
, PropertyChangeMask
);
716 /* Tell 'em the INCR data is there... */
717 TRACE0 ("Send SelectionNotify event");
718 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
721 had_errors
= x_had_errors_p (display
);
724 /* First, wait for the requester to ack by deleting the property.
725 This can run random lisp code (process handlers) or signal. */
728 TRACE1 ("Waiting for ACK (deletion of %s)",
729 XGetAtomName (display
, reply
.property
));
730 wait_for_property_change (wait_object
);
733 unexpect_property_change (wait_object
);
736 while (bytes_remaining
)
738 int i
= ((bytes_remaining
< max_bytes
)
740 : max_bytes
) / format_bytes
;
745 = expect_property_change (display
, window
, reply
.property
,
748 TRACE1 ("Sending increment of %d elements", i
);
749 TRACE1 ("Set %s to increment data",
750 XGetAtomName (display
, reply
.property
));
752 /* Append the next chunk of data to the property. */
753 XChangeProperty (display
, window
, reply
.property
, type
, format
,
754 PropModeAppend
, data
, i
);
755 bytes_remaining
-= i
* format_bytes
;
757 data
+= i
* sizeof (long);
759 data
+= i
* format_bytes
;
761 had_errors
= x_had_errors_p (display
);
767 /* Now wait for the requester to ack this chunk by deleting the
768 property. This can run random lisp code or signal. */
769 TRACE1 ("Waiting for increment ACK (deletion of %s)",
770 XGetAtomName (display
, reply
.property
));
771 wait_for_property_change (wait_object
);
774 /* Now write a zero-length chunk to the property to tell the
775 requester that we're done. */
777 if (! waiting_for_other_props_on_window (display
, window
))
778 XSelectInput (display
, window
, 0L);
780 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
781 XGetAtomName (display
, reply
.property
));
782 XChangeProperty (display
, window
, reply
.property
, type
, format
,
783 PropModeReplace
, data
, 0);
784 TRACE0 ("Done sending incrementally");
787 /* rms, 2003-01-03: I think I have fixed this bug. */
788 /* The window we're communicating with may have been deleted
789 in the meantime (that's a real situation from a bug report).
790 In this case, there may be events in the event queue still
791 refering to the deleted window, and we'll get a BadWindow error
792 in XTread_socket when processing the events. I don't have
793 an idea how to fix that. gerd, 2001-01-98. */
794 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
795 delivered before uncatch errors. */
796 XSync (display
, False
);
799 /* GTK queues events in addition to the queue in Xlib. So we
800 UNBLOCK to enter the event loop and get possible errors delivered,
801 and then BLOCK again because x_uncatch_errors requires it. */
803 /* This calls x_uncatch_errors. */
804 unbind_to (count
, Qnil
);
808 /* Handle a SelectionRequest event EVENT.
809 This is called from keyboard.c when such an event is found in the queue. */
812 x_handle_selection_request (struct input_event
*event
)
814 struct gcpro gcpro1
, gcpro2
, gcpro3
;
815 Lisp_Object local_selection_data
;
816 Lisp_Object selection_symbol
;
817 Lisp_Object target_symbol
;
818 Lisp_Object converted_selection
;
819 Time local_selection_time
;
820 Lisp_Object successful_p
;
822 struct x_display_info
*dpyinfo
823 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
825 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
826 (unsigned long) SELECTION_EVENT_REQUESTOR (event
),
827 (unsigned long) SELECTION_EVENT_TIME (event
));
829 local_selection_data
= Qnil
;
830 target_symbol
= Qnil
;
831 converted_selection
= Qnil
;
834 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
836 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
837 SELECTION_EVENT_SELECTION (event
));
839 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
841 if (NILP (local_selection_data
))
843 /* Someone asked for the selection, but we don't have it any more.
845 x_decline_selection_request (event
);
849 local_selection_time
= (Time
)
850 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
852 if (SELECTION_EVENT_TIME (event
) != CurrentTime
853 && local_selection_time
> SELECTION_EVENT_TIME (event
))
855 /* Someone asked for the selection, and we have one, but not the one
858 x_decline_selection_request (event
);
862 x_selection_current_request
= event
;
863 count
= SPECPDL_INDEX ();
864 selection_request_dpyinfo
= dpyinfo
;
865 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
867 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
868 SELECTION_EVENT_TARGET (event
));
870 #if 0 /* #### MULTIPLE doesn't work yet */
871 if (EQ (target_symbol
, QMULTIPLE
))
872 target_symbol
= fetch_multiple_target (event
);
875 /* Convert lisp objects back into binary data */
878 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
880 if (! NILP (converted_selection
))
888 if (CONSP (converted_selection
) && NILP (XCDR (converted_selection
)))
890 x_decline_selection_request (event
);
894 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
896 &data
, &type
, &size
, &format
, &nofree
);
898 x_reply_selection_request (event
, format
, data
, size
, type
);
901 /* Indicate we have successfully processed this event. */
902 x_selection_current_request
= 0;
904 /* Use xfree, not XFree, because lisp_data_to_selection_data
905 calls xmalloc itself. */
911 unbind_to (count
, Qnil
);
915 /* Let random lisp code notice that the selection has been asked for. */
918 rest
= Vx_sent_selection_functions
;
919 if (!EQ (rest
, Qunbound
))
920 for (; CONSP (rest
); rest
= Fcdr (rest
))
921 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
927 /* Handle a SelectionClear event EVENT, which indicates that some
928 client cleared out our previously asserted selection.
929 This is called from keyboard.c when such an event is found in the queue. */
932 x_handle_selection_clear (struct input_event
*event
)
934 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
935 Atom selection
= SELECTION_EVENT_SELECTION (event
);
936 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
938 Lisp_Object selection_symbol
, local_selection_data
;
939 Time local_selection_time
;
940 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
941 struct x_display_info
*t_dpyinfo
;
943 TRACE0 ("x_handle_selection_clear");
945 /* If the new selection owner is also Emacs,
946 don't clear the new selection. */
948 /* Check each display on the same terminal,
949 to see if this Emacs job now owns the selection
950 through that display. */
951 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
952 if (t_dpyinfo
->terminal
->kboard
== dpyinfo
->terminal
->kboard
)
955 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
956 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
964 selection_symbol
= x_atom_to_symbol (display
, selection
);
966 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
968 /* Well, we already believe that we don't own it, so that's just fine. */
969 if (NILP (local_selection_data
)) return;
971 local_selection_time
= (Time
)
972 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
974 /* This SelectionClear is for a selection that we no longer own, so we can
975 disregard it. (That is, we have reasserted the selection since this
976 request was generated.) */
978 if (changed_owner_time
!= CurrentTime
979 && local_selection_time
> changed_owner_time
)
982 /* Otherwise, we're really honest and truly being told to drop it.
983 Don't use Fdelq as that may QUIT;. */
985 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
986 Vselection_alist
= Fcdr (Vselection_alist
);
990 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
991 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
993 XSETCDR (rest
, Fcdr (XCDR (rest
)));
998 /* Let random lisp code notice that the selection has been stolen. */
1002 rest
= Vx_lost_selection_functions
;
1003 if (!EQ (rest
, Qunbound
))
1005 for (; CONSP (rest
); rest
= Fcdr (rest
))
1006 call1 (Fcar (rest
), selection_symbol
);
1007 prepare_menu_bars ();
1008 redisplay_preserve_echo_area (20);
1014 x_handle_selection_event (struct input_event
*event
)
1016 TRACE0 ("x_handle_selection_event");
1018 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1020 if (x_queue_selection_requests
)
1021 x_queue_event (event
);
1023 x_handle_selection_request (event
);
1026 x_handle_selection_clear (event
);
1030 /* Clear all selections that were made from frame F.
1031 We do this when about to delete a frame. */
1034 x_clear_frame_selections (FRAME_PTR f
)
1039 XSETFRAME (frame
, f
);
1041 /* Otherwise, we're really honest and truly being told to drop it.
1042 Don't use Fdelq as that may QUIT;. */
1044 /* Delete elements from the beginning of Vselection_alist. */
1045 while (!NILP (Vselection_alist
)
1046 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1048 /* Let random Lisp code notice that the selection has been stolen. */
1049 Lisp_Object hooks
, selection_symbol
;
1051 hooks
= Vx_lost_selection_functions
;
1052 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1054 if (!EQ (hooks
, Qunbound
))
1056 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1057 call1 (Fcar (hooks
), selection_symbol
);
1058 #if 0 /* This can crash when deleting a frame
1059 from x_connection_closed. Anyway, it seems unnecessary;
1060 something else should cause a redisplay. */
1061 redisplay_preserve_echo_area (21);
1065 Vselection_alist
= Fcdr (Vselection_alist
);
1068 /* Delete elements after the beginning of Vselection_alist. */
1069 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1070 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1072 /* Let random Lisp code notice that the selection has been stolen. */
1073 Lisp_Object hooks
, selection_symbol
;
1075 hooks
= Vx_lost_selection_functions
;
1076 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1078 if (!EQ (hooks
, Qunbound
))
1080 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1081 call1 (Fcar (hooks
), selection_symbol
);
1082 #if 0 /* See above */
1083 redisplay_preserve_echo_area (22);
1086 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1091 /* Nonzero if any properties for DISPLAY and WINDOW
1092 are on the list of what we are waiting for. */
1095 waiting_for_other_props_on_window (Display
*display
, Window window
)
1097 struct prop_location
*rest
= property_change_wait_list
;
1099 if (rest
->display
== display
&& rest
->window
== window
)
1106 /* Add an entry to the list of property changes we are waiting for.
1107 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1108 The return value is a number that uniquely identifies
1109 this awaited property change. */
1111 static struct prop_location
*
1112 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1114 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1115 pl
->identifier
= ++prop_location_identifier
;
1116 pl
->display
= display
;
1117 pl
->window
= window
;
1118 pl
->property
= property
;
1119 pl
->desired_state
= state
;
1120 pl
->next
= property_change_wait_list
;
1122 property_change_wait_list
= pl
;
1126 /* Delete an entry from the list of property changes we are waiting for.
1127 IDENTIFIER is the number that uniquely identifies the entry. */
1130 unexpect_property_change (struct prop_location
*location
)
1132 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1135 if (rest
== location
)
1138 prev
->next
= rest
->next
;
1140 property_change_wait_list
= rest
->next
;
1149 /* Remove the property change expectation element for IDENTIFIER. */
1152 wait_for_property_change_unwind (Lisp_Object loc
)
1154 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1156 unexpect_property_change (location
);
1157 if (location
== property_change_reply_object
)
1158 property_change_reply_object
= 0;
1162 /* Actually wait for a property change.
1163 IDENTIFIER should be the value that expect_property_change returned. */
1166 wait_for_property_change (struct prop_location
*location
)
1169 int count
= SPECPDL_INDEX ();
1171 if (property_change_reply_object
)
1174 /* Make sure to do unexpect_property_change if we quit or err. */
1175 record_unwind_protect (wait_for_property_change_unwind
,
1176 make_save_value (location
, 0));
1178 XSETCAR (property_change_reply
, Qnil
);
1179 property_change_reply_object
= location
;
1181 /* If the event we are waiting for arrives beyond here, it will set
1182 property_change_reply, because property_change_reply_object says so. */
1183 if (! location
->arrived
)
1185 secs
= x_selection_timeout
/ 1000;
1186 usecs
= (x_selection_timeout
% 1000) * 1000;
1187 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1188 wait_reading_process_output (secs
, usecs
, 0, 0,
1189 property_change_reply
, NULL
, 0);
1191 if (NILP (XCAR (property_change_reply
)))
1193 TRACE0 (" Timed out");
1194 error ("Timed out waiting for property-notify event");
1198 unbind_to (count
, Qnil
);
1201 /* Called from XTread_socket in response to a PropertyNotify event. */
1204 x_handle_property_notify (XPropertyEvent
*event
)
1206 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1211 && rest
->property
== event
->atom
1212 && rest
->window
== event
->window
1213 && rest
->display
== event
->display
1214 && rest
->desired_state
== event
->state
)
1216 TRACE2 ("Expected %s of property %s",
1217 (event
->state
== PropertyDelete
? "deletion" : "change"),
1218 XGetAtomName (event
->display
, event
->atom
));
1222 /* If this is the one wait_for_property_change is waiting for,
1223 tell it to wake up. */
1224 if (rest
== property_change_reply_object
)
1225 XSETCAR (property_change_reply
, Qt
);
1237 #if 0 /* #### MULTIPLE doesn't work yet */
1240 fetch_multiple_target (event
)
1241 XSelectionRequestEvent
*event
;
1243 Display
*display
= event
->display
;
1244 Window window
= event
->requestor
;
1245 Atom target
= event
->target
;
1246 Atom selection_atom
= event
->selection
;
1251 x_get_window_property_as_lisp_data (display
, window
, target
,
1252 QMULTIPLE
, selection_atom
));
1256 copy_multiple_data (obj
)
1263 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1266 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1267 for (i
= 0; i
< size
; i
++)
1269 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1270 CHECK_VECTOR (vec2
);
1271 if (XVECTOR (vec2
)->size
!= 2)
1272 /* ??? Confusing error message */
1273 signal_error ("Vectors must be of length 2", vec2
);
1274 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1275 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1276 = XVECTOR (vec2
)->contents
[0];
1277 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1278 = XVECTOR (vec2
)->contents
[1];
1286 /* Variables for communication with x_handle_selection_notify. */
1287 static Atom reading_which_selection
;
1288 static Lisp_Object reading_selection_reply
;
1289 static Window reading_selection_window
;
1291 /* Do protocol to read selection-data from the server.
1292 Converts this to Lisp data and returns it. */
1295 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
1297 struct frame
*sf
= SELECTED_FRAME ();
1298 Window requestor_window
;
1300 struct x_display_info
*dpyinfo
;
1301 Time requestor_time
= last_event_timestamp
;
1302 Atom target_property
;
1303 Atom selection_atom
;
1306 int count
= SPECPDL_INDEX ();
1309 if (! FRAME_X_P (sf
))
1312 requestor_window
= FRAME_X_WINDOW (sf
);
1313 display
= FRAME_X_DISPLAY (sf
);
1314 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1315 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1316 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1318 if (CONSP (target_type
))
1319 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1321 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1323 if (! NILP (time_stamp
))
1325 if (CONSP (time_stamp
))
1326 requestor_time
= (Time
) cons_to_long (time_stamp
);
1327 else if (INTEGERP (time_stamp
))
1328 requestor_time
= (Time
) XUINT (time_stamp
);
1329 else if (FLOATP (time_stamp
))
1330 requestor_time
= (Time
) XFLOAT_DATA (time_stamp
);
1332 error ("TIME_STAMP must be cons or number");
1337 /* The protected block contains wait_reading_process_output, which
1338 can run random lisp code (process handlers) or signal.
1339 Therefore, we put the x_uncatch_errors call in an unwind. */
1340 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
1341 x_catch_errors (display
);
1343 TRACE2 ("Get selection %s, type %s",
1344 XGetAtomName (display
, type_atom
),
1345 XGetAtomName (display
, target_property
));
1347 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1348 requestor_window
, requestor_time
);
1351 /* Prepare to block until the reply has been read. */
1352 reading_selection_window
= requestor_window
;
1353 reading_which_selection
= selection_atom
;
1354 XSETCAR (reading_selection_reply
, Qnil
);
1356 frame
= some_frame_on_display (dpyinfo
);
1358 /* If the display no longer has frames, we can't expect
1359 to get many more selection requests from it, so don't
1360 bother trying to queue them. */
1363 x_start_queuing_selection_requests ();
1365 record_unwind_protect (queue_selection_requests_unwind
,
1370 /* This allows quits. Also, don't wait forever. */
1371 secs
= x_selection_timeout
/ 1000;
1372 usecs
= (x_selection_timeout
% 1000) * 1000;
1373 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1374 wait_reading_process_output (secs
, usecs
, 0, 0,
1375 reading_selection_reply
, NULL
, 0);
1376 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1379 if (x_had_errors_p (display
))
1380 error ("Cannot get selection");
1381 /* This calls x_uncatch_errors. */
1382 unbind_to (count
, Qnil
);
1385 if (NILP (XCAR (reading_selection_reply
)))
1386 error ("Timed out waiting for reply from selection owner");
1387 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1390 /* Otherwise, the selection is waiting for us on the requested property. */
1392 x_get_window_property_as_lisp_data (display
, requestor_window
,
1393 target_property
, target_type
,
1397 /* Subroutines of x_get_window_property_as_lisp_data */
1399 /* Use xfree, not XFree, to free the data obtained with this function. */
1402 x_get_window_property (Display
*display
, Window window
, Atom property
,
1403 unsigned char **data_ret
, int *bytes_ret
,
1404 Atom
*actual_type_ret
, int *actual_format_ret
,
1405 unsigned long *actual_size_ret
, int delete_p
)
1408 unsigned long bytes_remaining
;
1410 unsigned char *tmp_data
= 0;
1412 int buffer_size
= SELECTION_QUANTUM (display
);
1414 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1415 buffer_size
= MAX_SELECTION_QUANTUM
;
1419 /* First probe the thing to find out how big it is. */
1420 result
= XGetWindowProperty (display
, window
, property
,
1421 0L, 0L, False
, AnyPropertyType
,
1422 actual_type_ret
, actual_format_ret
,
1424 &bytes_remaining
, &tmp_data
);
1425 if (result
!= Success
)
1433 /* This was allocated by Xlib, so use XFree. */
1434 XFree ((char *) tmp_data
);
1436 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1442 total_size
= bytes_remaining
+ 1;
1443 *data_ret
= (unsigned char *) xmalloc (total_size
);
1445 /* Now read, until we've gotten it all. */
1446 while (bytes_remaining
)
1448 #ifdef TRACE_SELECTION
1449 int last
= bytes_remaining
;
1452 = XGetWindowProperty (display
, window
, property
,
1453 (long)offset
/4, (long)buffer_size
/4,
1456 actual_type_ret
, actual_format_ret
,
1457 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1459 TRACE2 ("Read %ld bytes from property %s",
1460 last
- bytes_remaining
,
1461 XGetAtomName (display
, property
));
1463 /* If this doesn't return Success at this point, it means that
1464 some clod deleted the selection while we were in the midst of
1465 reading it. Deal with that, I guess.... */
1466 if (result
!= Success
)
1469 /* The man page for XGetWindowProperty says:
1470 "If the returned format is 32, the returned data is represented
1471 as a long array and should be cast to that type to obtain the
1473 This applies even if long is more than 32 bits, the X library
1474 converts from 32 bit elements received from the X server to long
1475 and passes the long array to us. Thus, for that case memcpy can not
1476 be used. We convert to a 32 bit type here, because so much code
1479 The bytes and offsets passed to XGetWindowProperty refers to the
1480 property and those are indeed in 32 bit quantities if format is 32. */
1482 if (*actual_format_ret
== 32 && *actual_format_ret
< BITS_PER_LONG
)
1485 int *idata
= (int *) ((*data_ret
) + offset
);
1486 long *ldata
= (long *) tmp_data
;
1488 for (i
= 0; i
< *actual_size_ret
; ++i
)
1490 idata
[i
]= (int) ldata
[i
];
1496 *actual_size_ret
*= *actual_format_ret
/ 8;
1497 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1498 offset
+= *actual_size_ret
;
1501 /* This was allocated by Xlib, so use XFree. */
1502 XFree ((char *) tmp_data
);
1507 *bytes_ret
= offset
;
1510 /* Use xfree, not XFree, to free the data obtained with this function. */
1513 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1514 Lisp_Object target_type
,
1515 unsigned int min_size_bytes
,
1516 unsigned char **data_ret
, int *size_bytes_ret
,
1517 Atom
*type_ret
, int *format_ret
,
1518 unsigned long *size_ret
)
1521 struct prop_location
*wait_object
;
1522 *size_bytes_ret
= min_size_bytes
;
1523 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1525 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1527 /* At this point, we have read an INCR property.
1528 Delete the property to ack it.
1529 (But first, prepare to receive the next event in this handshake.)
1531 Now, we must loop, waiting for the sending window to put a value on
1532 that property, then reading the property, then deleting it to ack.
1533 We are done when the sender places a property of length 0.
1536 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1537 TRACE1 (" Delete property %s",
1538 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1539 XDeleteProperty (display
, window
, property
);
1540 TRACE1 (" Expect new value of property %s",
1541 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1542 wait_object
= expect_property_change (display
, window
, property
,
1549 unsigned char *tmp_data
;
1552 TRACE0 (" Wait for property change");
1553 wait_for_property_change (wait_object
);
1555 /* expect it again immediately, because x_get_window_property may
1556 .. no it won't, I don't get it.
1557 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1558 TRACE0 (" Get property value");
1559 x_get_window_property (display
, window
, property
,
1560 &tmp_data
, &tmp_size_bytes
,
1561 type_ret
, format_ret
, size_ret
, 1);
1563 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1565 if (tmp_size_bytes
== 0) /* we're done */
1567 TRACE0 ("Done reading incrementally");
1569 if (! waiting_for_other_props_on_window (display
, window
))
1570 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1571 /* Use xfree, not XFree, because x_get_window_property
1572 calls xmalloc itself. */
1578 TRACE1 (" ACK by deleting property %s",
1579 XGetAtomName (display
, property
));
1580 XDeleteProperty (display
, window
, property
);
1581 wait_object
= expect_property_change (display
, window
, property
,
1586 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1588 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1589 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1592 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1593 offset
+= tmp_size_bytes
;
1595 /* Use xfree, not XFree, because x_get_window_property
1596 calls xmalloc itself. */
1602 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1603 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1604 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1607 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1609 Lisp_Object target_type
,
1610 Atom selection_atom
)
1614 unsigned long actual_size
;
1615 unsigned char *data
= 0;
1618 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1620 TRACE0 ("Reading selection data");
1622 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1623 &actual_type
, &actual_format
, &actual_size
, 1);
1626 int there_is_a_selection_owner
;
1628 there_is_a_selection_owner
1629 = XGetSelectionOwner (display
, selection_atom
);
1631 if (there_is_a_selection_owner
)
1632 signal_error ("Selection owner couldn't convert",
1634 ? list2 (target_type
,
1635 x_atom_to_symbol (display
, actual_type
))
1638 signal_error ("No selection",
1639 x_atom_to_symbol (display
, selection_atom
));
1642 if (actual_type
== dpyinfo
->Xatom_INCR
)
1644 /* That wasn't really the data, just the beginning. */
1646 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1648 /* Use xfree, not XFree, because x_get_window_property
1649 calls xmalloc itself. */
1650 xfree ((char *) data
);
1652 receive_incremental_selection (display
, window
, property
, target_type
,
1653 min_size_bytes
, &data
, &bytes
,
1654 &actual_type
, &actual_format
,
1659 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1660 XDeleteProperty (display
, window
, property
);
1664 /* It's been read. Now convert it to a lisp object in some semi-rational
1666 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1667 actual_type
, actual_format
);
1669 /* Use xfree, not XFree, because x_get_window_property
1670 calls xmalloc itself. */
1671 xfree ((char *) data
);
1675 /* These functions convert from the selection data read from the server into
1676 something that we can use from Lisp, and vice versa.
1678 Type: Format: Size: Lisp Type:
1679 ----- ------- ----- -----------
1682 ATOM 32 > 1 Vector of Symbols
1684 * 16 > 1 Vector of Integers
1685 * 32 1 if <=16 bits: Integer
1686 if > 16 bits: Cons of top16, bot16
1687 * 32 > 1 Vector of the above
1689 When converting a Lisp number to C, it is assumed to be of format 16 if
1690 it is an integer, and of format 32 if it is a cons of two integers.
1692 When converting a vector of numbers from Lisp to C, it is assumed to be
1693 of format 16 if every element in the vector is an integer, and is assumed
1694 to be of format 32 if any element is a cons of two integers.
1696 When converting an object to C, it may be of the form (SYMBOL . <data>)
1697 where SYMBOL is what we should claim that the type is. Format and
1698 representation are as above.
1700 Important: When format is 32, data should contain an array of int,
1701 not an array of long as the X library returns. This makes a difference
1702 when sizeof(long) != sizeof(int). */
1707 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1708 int size
, Atom type
, int format
)
1710 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1712 if (type
== dpyinfo
->Xatom_NULL
)
1715 /* Convert any 8-bit data to a string, for compactness. */
1716 else if (format
== 8)
1718 Lisp_Object str
, lispy_type
;
1720 str
= make_unibyte_string ((char *) data
, size
);
1721 /* Indicate that this string is from foreign selection by a text
1722 property `foreign-selection' so that the caller of
1723 x-get-selection-internal (usually x-get-selection) can know
1724 that the string must be decode. */
1725 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1726 lispy_type
= QCOMPOUND_TEXT
;
1727 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1728 lispy_type
= QUTF8_STRING
;
1730 lispy_type
= QSTRING
;
1731 Fput_text_property (make_number (0), make_number (size
),
1732 Qforeign_selection
, lispy_type
, str
);
1735 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1736 a vector of symbols.
1738 else if (type
== XA_ATOM
)
1741 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1742 But the callers of these function has made sure the data for
1743 format == 32 is an array of int. Thus, use int instead
1745 int *idata
= (int *) data
;
1747 if (size
== sizeof (int))
1748 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1751 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1753 for (i
= 0; i
< size
/ sizeof (int); i
++)
1754 Faset (v
, make_number (i
),
1755 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1760 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1761 If the number is 32 bits and won't fit in a Lisp_Int,
1762 convert it to a cons of integers, 16 bits in each half.
1764 else if (format
== 32 && size
== sizeof (int))
1765 return long_to_cons (((unsigned int *) data
) [0]);
1766 else if (format
== 16 && size
== sizeof (short))
1767 return make_number ((int) (((unsigned short *) data
) [0]));
1769 /* Convert any other kind of data to a vector of numbers, represented
1770 as above (as an integer, or a cons of two 16 bit integers.)
1772 else if (format
== 16)
1776 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1777 for (i
= 0; i
< size
/ 2; i
++)
1779 int j
= (int) ((unsigned short *) data
) [i
];
1780 Faset (v
, make_number (i
), make_number (j
));
1787 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1788 for (i
= 0; i
< size
/ 4; i
++)
1790 unsigned int j
= ((unsigned int *) data
) [i
];
1791 Faset (v
, make_number (i
), long_to_cons (j
));
1798 /* Use xfree, not XFree, to free the data obtained with this function. */
1801 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1802 unsigned char **data_ret
, Atom
*type_ret
,
1803 unsigned int *size_ret
,
1804 int *format_ret
, int *nofree_ret
)
1806 Lisp_Object type
= Qnil
;
1807 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1811 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1815 if (CONSP (obj
) && NILP (XCDR (obj
)))
1819 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1820 { /* This is not the same as declining */
1826 else if (STRINGP (obj
))
1828 if (SCHARS (obj
) < SBYTES (obj
))
1829 /* OBJ is a multibyte string containing a non-ASCII char. */
1830 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1834 *size_ret
= SBYTES (obj
);
1835 *data_ret
= SDATA (obj
);
1838 else if (SYMBOLP (obj
))
1842 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1843 (*data_ret
) [sizeof (Atom
)] = 0;
1844 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1845 if (NILP (type
)) type
= QATOM
;
1847 else if (INTEGERP (obj
)
1848 && XINT (obj
) < 0xFFFF
1849 && XINT (obj
) > -0xFFFF)
1853 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1854 (*data_ret
) [sizeof (short)] = 0;
1855 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1856 if (NILP (type
)) type
= QINTEGER
;
1858 else if (INTEGERP (obj
)
1859 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1860 && (INTEGERP (XCDR (obj
))
1861 || (CONSP (XCDR (obj
))
1862 && INTEGERP (XCAR (XCDR (obj
)))))))
1866 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1867 (*data_ret
) [sizeof (long)] = 0;
1868 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1869 if (NILP (type
)) type
= QINTEGER
;
1871 else if (VECTORP (obj
))
1873 /* Lisp_Vectors may represent a set of ATOMs;
1874 a set of 16 or 32 bit INTEGERs;
1875 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1879 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1880 /* This vector is an ATOM set */
1882 if (NILP (type
)) type
= QATOM
;
1883 *size_ret
= XVECTOR (obj
)->size
;
1885 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1886 for (i
= 0; i
< *size_ret
; i
++)
1887 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1888 (*(Atom
**) data_ret
) [i
]
1889 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1891 signal_error ("All elements of selection vector must have same type", obj
);
1893 #if 0 /* #### MULTIPLE doesn't work yet */
1894 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1895 /* This vector is an ATOM_PAIR set */
1897 if (NILP (type
)) type
= QATOM_PAIR
;
1898 *size_ret
= XVECTOR (obj
)->size
;
1900 *data_ret
= (unsigned char *)
1901 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1902 for (i
= 0; i
< *size_ret
; i
++)
1903 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1905 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1906 if (XVECTOR (pair
)->size
!= 2)
1908 "Elements of the vector must be vectors of exactly two elements",
1911 (*(Atom
**) data_ret
) [i
* 2]
1912 = symbol_to_x_atom (dpyinfo
, display
,
1913 XVECTOR (pair
)->contents
[0]);
1914 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1915 = symbol_to_x_atom (dpyinfo
, display
,
1916 XVECTOR (pair
)->contents
[1]);
1919 signal_error ("All elements of the vector must be of the same type",
1925 /* This vector is an INTEGER set, or something like it */
1928 *size_ret
= XVECTOR (obj
)->size
;
1929 if (NILP (type
)) type
= QINTEGER
;
1931 for (i
= 0; i
< *size_ret
; i
++)
1932 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1934 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1935 signal_error (/* Qselection_error */
1936 "Elements of selection vector must be integers or conses of integers",
1939 /* Use sizeof(long) even if it is more than 32 bits. See comment
1940 in x_get_window_property and x_fill_property_data. */
1942 if (*format_ret
== 32) data_size
= sizeof(long);
1943 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1944 for (i
= 0; i
< *size_ret
; i
++)
1945 if (*format_ret
== 32)
1946 (*((unsigned long **) data_ret
)) [i
]
1947 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1949 (*((unsigned short **) data_ret
)) [i
]
1950 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1954 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1956 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1960 clean_local_selection_data (Lisp_Object obj
)
1963 && INTEGERP (XCAR (obj
))
1964 && CONSP (XCDR (obj
))
1965 && INTEGERP (XCAR (XCDR (obj
)))
1966 && NILP (XCDR (XCDR (obj
))))
1967 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1970 && INTEGERP (XCAR (obj
))
1971 && INTEGERP (XCDR (obj
)))
1973 if (XINT (XCAR (obj
)) == 0)
1975 if (XINT (XCAR (obj
)) == -1)
1976 return make_number (- XINT (XCDR (obj
)));
1981 int size
= XVECTOR (obj
)->size
;
1984 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1985 copy
= Fmake_vector (make_number (size
), Qnil
);
1986 for (i
= 0; i
< size
; i
++)
1987 XVECTOR (copy
)->contents
[i
]
1988 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1994 /* Called from XTread_socket to handle SelectionNotify events.
1995 If it's the selection we are waiting for, stop waiting
1996 by setting the car of reading_selection_reply to non-nil.
1997 We store t there if the reply is successful, lambda if not. */
2000 x_handle_selection_notify (XSelectionEvent
*event
)
2002 if (event
->requestor
!= reading_selection_window
)
2004 if (event
->selection
!= reading_which_selection
)
2007 TRACE0 ("Received SelectionNotify");
2008 XSETCAR (reading_selection_reply
,
2009 (event
->property
!= 0 ? Qt
: Qlambda
));
2013 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2014 Sx_own_selection_internal
, 2, 2, 0,
2015 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2016 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2017 \(Those are literal upper-case symbol names, since that's what X expects.)
2018 VALUE is typically a string, or a cons of two markers, but may be
2019 anything that the functions on `selection-converter-alist' know about. */)
2020 (Lisp_Object selection_name
, Lisp_Object selection_value
)
2023 CHECK_SYMBOL (selection_name
);
2024 if (NILP (selection_value
)) error ("SELECTION-VALUE may not be nil");
2025 x_own_selection (selection_name
, selection_value
);
2026 return selection_value
;
2030 /* Request the selection value from the owner. If we are the owner,
2031 simply return our selection value. If we are not the owner, this
2032 will block until all of the data has arrived. */
2034 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2035 Sx_get_selection_internal
, 2, 3, 0,
2036 doc
: /* Return text selected from some X window.
2037 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2038 \(Those are literal upper-case symbol names, since that's what X expects.)
2039 TYPE is the type of data desired, typically `STRING'.
2040 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2041 selections. If omitted, defaults to the time for the last event. */)
2042 (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
2044 Lisp_Object val
= Qnil
;
2045 struct gcpro gcpro1
, gcpro2
;
2046 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2048 CHECK_SYMBOL (selection_symbol
);
2050 #if 0 /* #### MULTIPLE doesn't work yet */
2051 if (CONSP (target_type
)
2052 && XCAR (target_type
) == QMULTIPLE
)
2054 CHECK_VECTOR (XCDR (target_type
));
2055 /* So we don't destructively modify this... */
2056 target_type
= copy_multiple_data (target_type
);
2060 CHECK_SYMBOL (target_type
);
2062 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2066 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2071 && SYMBOLP (XCAR (val
)))
2074 if (CONSP (val
) && NILP (XCDR (val
)))
2077 val
= clean_local_selection_data (val
);
2083 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2084 Sx_disown_selection_internal
, 1, 2, 0,
2085 doc
: /* If we own the selection SELECTION, disown it.
2086 Disowning it means there is no such selection. */)
2087 (Lisp_Object selection
, Lisp_Object time_object
)
2090 Atom selection_atom
;
2092 struct selection_input_event sie
;
2093 struct input_event ie
;
2096 struct x_display_info
*dpyinfo
;
2097 struct frame
*sf
= SELECTED_FRAME ();
2100 if (! FRAME_X_P (sf
))
2103 display
= FRAME_X_DISPLAY (sf
);
2104 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2105 CHECK_SYMBOL (selection
);
2106 if (NILP (time_object
))
2107 timestamp
= last_event_timestamp
;
2109 timestamp
= cons_to_long (time_object
);
2111 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2112 return Qnil
; /* Don't disown the selection when we're not the owner. */
2114 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2117 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2120 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2121 generated for a window which owns the selection when that window sets
2122 the selection owner to None. The NCD server does, the MIT Sun4 server
2123 doesn't. So we synthesize one; this means we might get two, but
2124 that's ok, because the second one won't have any effect. */
2125 SELECTION_EVENT_DISPLAY (&event
.sie
) = display
;
2126 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2127 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2128 x_handle_selection_clear (&event
.ie
);
2133 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2135 doc
: /* Whether the current Emacs process owns the given X Selection.
2136 The arg should be the name of the selection in question, typically one of
2137 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2138 \(Those are literal upper-case symbol names, since that's what X expects.)
2139 For convenience, the symbol nil is the same as `PRIMARY',
2140 and t is the same as `SECONDARY'. */)
2141 (Lisp_Object selection
)
2144 CHECK_SYMBOL (selection
);
2145 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2146 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2148 if (NILP (Fassq (selection
, Vselection_alist
)))
2153 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2155 doc
: /* Whether there is an owner for the given X Selection.
2156 The arg should be the name of the selection in question, typically one of
2157 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2158 \(Those are literal upper-case symbol names, since that's what X expects.)
2159 For convenience, the symbol nil is the same as `PRIMARY',
2160 and t is the same as `SECONDARY'. */)
2161 (Lisp_Object selection
)
2166 struct frame
*sf
= SELECTED_FRAME ();
2168 /* It should be safe to call this before we have an X frame. */
2169 if (! FRAME_X_P (sf
))
2172 dpy
= FRAME_X_DISPLAY (sf
);
2173 CHECK_SYMBOL (selection
);
2174 if (!NILP (Fx_selection_owner_p (selection
)))
2176 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2177 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2178 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2182 owner
= XGetSelectionOwner (dpy
, atom
);
2184 return (owner
? Qt
: Qnil
);
2188 /***********************************************************************
2189 Drag and drop support
2190 ***********************************************************************/
2191 /* Check that lisp values are of correct type for x_fill_property_data.
2192 That is, number, string or a cons with two numbers (low and high 16
2193 bit parts of a 32 bit number). */
2196 x_check_property_data (Lisp_Object data
)
2201 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2203 Lisp_Object o
= XCAR (iter
);
2205 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2207 else if (CONSP (o
) &&
2208 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2215 /* Convert lisp values to a C array. Values may be a number, a string
2216 which is taken as an X atom name and converted to the atom value, or
2217 a cons containing the two 16 bit parts of a 32 bit number.
2219 DPY is the display use to look up X atoms.
2220 DATA is a Lisp list of values to be converted.
2221 RET is the C array that contains the converted values. It is assumed
2222 it is big enough to hold all values.
2223 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2224 be stored in RET. Note that long is used for 32 even if long is more
2225 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2226 XClientMessageEvent). */
2229 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2232 long *d32
= (long *) ret
;
2233 short *d16
= (short *) ret
;
2234 char *d08
= (char *) ret
;
2237 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2239 Lisp_Object o
= XCAR (iter
);
2242 val
= (long) XFASTINT (o
);
2243 else if (FLOATP (o
))
2244 val
= (long) XFLOAT_DATA (o
);
2246 val
= (long) cons_to_long (o
);
2247 else if (STRINGP (o
))
2250 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2254 error ("Wrong type, must be string, number or cons");
2257 *d08
++ = (char) val
;
2258 else if (format
== 16)
2259 *d16
++ = (short) val
;
2265 /* Convert an array of C values to a Lisp list.
2266 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2267 DATA is a C array of values to be converted.
2268 TYPE is the type of the data. Only XA_ATOM is special, it converts
2269 each number in DATA to its corresponfing X atom as a symbol.
2270 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2272 SIZE is the number of elements in DATA.
2274 Important: When format is 32, data should contain an array of int,
2275 not an array of long as the X library returns. This makes a difference
2276 when sizeof(long) != sizeof(int).
2278 Also see comment for selection_data_to_lisp_data above. */
2281 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2282 Atom type
, int format
, long unsigned int size
)
2284 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2285 data
, size
*format
/8, type
, format
);
2288 /* Get the mouse position in frame relative coordinates. */
2291 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2293 Window root
, dummy_window
;
2298 XQueryPointer (FRAME_X_DISPLAY (f
),
2299 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2301 /* The root window which contains the pointer. */
2304 /* Window pointer is on, not used */
2307 /* The position on that root window. */
2310 /* x/y in dummy_window coordinates, not used. */
2313 /* Modifier keys and pointer buttons, about which
2315 (unsigned int *) &dummy
);
2318 /* Absolute to relative. */
2319 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2320 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2325 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2326 Sx_get_atom_name
, 1, 2, 0,
2327 doc
: /* Return the X atom name for VALUE as a string.
2328 VALUE may be a number or a cons where the car is the upper 16 bits and
2329 the cdr is the lower 16 bits of a 32 bit value.
2330 Use the display for FRAME or the current frame if FRAME is not given or nil.
2332 If the value is 0 or the atom is not known, return the empty string. */)
2333 (Lisp_Object value
, Lisp_Object frame
)
2335 struct frame
*f
= check_x_frame (frame
);
2338 Lisp_Object ret
= Qnil
;
2339 Display
*dpy
= FRAME_X_DISPLAY (f
);
2343 if (INTEGERP (value
))
2344 atom
= (Atom
) XUINT (value
);
2345 else if (FLOATP (value
))
2346 atom
= (Atom
) XFLOAT_DATA (value
);
2347 else if (CONSP (value
))
2348 atom
= (Atom
) cons_to_long (value
);
2350 error ("Wrong type, value must be number or cons");
2353 x_catch_errors (dpy
);
2354 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2355 had_errors
= x_had_errors_p (dpy
);
2356 x_uncatch_errors ();
2359 ret
= make_string (name
, strlen (name
));
2361 if (atom
&& name
) XFree (name
);
2362 if (NILP (ret
)) ret
= empty_unibyte_string
;
2369 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2370 Sx_register_dnd_atom
, 1, 2, 0,
2371 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2372 ATOM can be a symbol or a string. The ATOM is interned on the display that
2373 FRAME is on. If FRAME is nil, the selected frame is used. */)
2374 (Lisp_Object atom
, Lisp_Object frame
)
2377 struct frame
*f
= check_x_frame (frame
);
2379 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2383 x_atom
= symbol_to_x_atom (dpyinfo
, FRAME_X_DISPLAY (f
), atom
);
2384 else if (STRINGP (atom
))
2387 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2391 error ("ATOM must be a symbol or a string");
2393 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2394 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2397 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2399 dpyinfo
->x_dnd_atoms_size
*= 2;
2400 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2401 sizeof (*dpyinfo
->x_dnd_atoms
)
2402 * dpyinfo
->x_dnd_atoms_size
);
2405 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2409 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2412 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2416 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2417 unsigned long size
= 160/event
->format
;
2419 unsigned char *data
= (unsigned char *) event
->data
.b
;
2423 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2424 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2426 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2428 XSETFRAME (frame
, f
);
2430 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2431 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2432 function expects them to be of size int (i.e. 32). So to be able to
2433 use that function, put the data in the form it expects if format is 32. */
2435 if (event
->format
== 32 && event
->format
< BITS_PER_LONG
)
2437 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2438 idata
[i
] = (int) event
->data
.l
[i
];
2439 data
= (unsigned char *) idata
;
2442 vec
= Fmake_vector (make_number (4), Qnil
);
2443 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2444 event
->message_type
)));
2445 ASET (vec
, 1, frame
);
2446 ASET (vec
, 2, make_number (event
->format
));
2447 ASET (vec
, 3, x_property_data_to_lisp (f
,
2449 event
->message_type
,
2453 mouse_position_for_drop (f
, &x
, &y
);
2454 bufp
->kind
= DRAG_N_DROP_EVENT
;
2455 bufp
->frame_or_window
= frame
;
2456 bufp
->timestamp
= CurrentTime
;
2457 bufp
->x
= make_number (x
);
2458 bufp
->y
= make_number (y
);
2460 bufp
->modifiers
= 0;
2465 DEFUN ("x-send-client-message", Fx_send_client_event
,
2466 Sx_send_client_message
, 6, 6, 0,
2467 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2469 For DISPLAY, specify either a frame or a display name (a string).
2470 If DISPLAY is nil, that stands for the selected frame's display.
2471 DEST may be a number, in which case it is a Window id. The value 0 may
2472 be used to send to the root window of the DISPLAY.
2473 If DEST is a cons, it is converted to a 32 bit number
2474 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2475 number is then used as a window id.
2476 If DEST is a frame the event is sent to the outer window of that frame.
2477 A value of nil means the currently selected frame.
2478 If DEST is the string "PointerWindow" the event is sent to the window that
2479 contains the pointer. If DEST is the string "InputFocus" the event is
2480 sent to the window that has the input focus.
2481 FROM is the frame sending the event. Use nil for currently selected frame.
2482 MESSAGE-TYPE is the name of an Atom as a string.
2483 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2484 bits. VALUES is a list of numbers, cons and/or strings containing the values
2485 to send. If a value is a string, it is converted to an Atom and the value of
2486 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2487 with the high 16 bits from the car and the lower 16 bit from the cdr.
2488 If more values than fits into the event is given, the excessive values
2490 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2492 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2494 CHECK_STRING (message_type
);
2495 x_send_client_event(display
, dest
, from
,
2496 XInternAtom (dpyinfo
->display
,
2497 SSDATA (message_type
),
2505 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2507 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2510 struct frame
*f
= check_x_frame (from
);
2513 CHECK_NUMBER (format
);
2514 CHECK_CONS (values
);
2516 if (x_check_property_data (values
) == -1)
2517 error ("Bad data in VALUES, must be number, cons or string");
2519 event
.xclient
.type
= ClientMessage
;
2520 event
.xclient
.format
= XFASTINT (format
);
2522 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2523 && event
.xclient
.format
!= 32)
2524 error ("FORMAT must be one of 8, 16 or 32");
2526 if (FRAMEP (dest
) || NILP (dest
))
2528 struct frame
*fdest
= check_x_frame (dest
);
2529 wdest
= FRAME_OUTER_WINDOW (fdest
);
2531 else if (STRINGP (dest
))
2533 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2534 wdest
= PointerWindow
;
2535 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2538 error ("DEST as a string must be one of PointerWindow or InputFocus");
2540 else if (INTEGERP (dest
))
2541 wdest
= (Window
) XFASTINT (dest
);
2542 else if (FLOATP (dest
))
2543 wdest
= (Window
) XFLOAT_DATA (dest
);
2544 else if (CONSP (dest
))
2546 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2547 error ("Both car and cdr for DEST must be numbers");
2549 wdest
= (Window
) cons_to_long (dest
);
2552 error ("DEST must be a frame, nil, string, number or cons");
2554 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2555 to_root
= wdest
== dpyinfo
->root_window
;
2559 event
.xclient
.message_type
= message_type
;
2560 event
.xclient
.display
= dpyinfo
->display
;
2562 /* Some clients (metacity for example) expects sending window to be here
2563 when sending to the root window. */
2564 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2567 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2568 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2569 event
.xclient
.format
);
2571 /* If event mask is 0 the event is sent to the client that created
2572 the destination window. But if we are sending to the root window,
2573 there is no such client. Then we set the event mask to 0xffff. The
2574 event then goes to clients selecting for events on the root window. */
2575 x_catch_errors (dpyinfo
->display
);
2577 int propagate
= to_root
? False
: True
;
2578 unsigned mask
= to_root
? 0xffff : 0;
2579 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2580 XFlush (dpyinfo
->display
);
2582 x_uncatch_errors ();
2588 syms_of_xselect (void)
2590 defsubr (&Sx_get_selection_internal
);
2591 defsubr (&Sx_own_selection_internal
);
2592 defsubr (&Sx_disown_selection_internal
);
2593 defsubr (&Sx_selection_owner_p
);
2594 defsubr (&Sx_selection_exists_p
);
2596 defsubr (&Sx_get_atom_name
);
2597 defsubr (&Sx_send_client_message
);
2598 defsubr (&Sx_register_dnd_atom
);
2600 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2601 staticpro (&reading_selection_reply
);
2602 reading_selection_window
= 0;
2603 reading_which_selection
= 0;
2605 property_change_wait_list
= 0;
2606 prop_location_identifier
= 0;
2607 property_change_reply
= Fcons (Qnil
, Qnil
);
2608 staticpro (&property_change_reply
);
2610 Vselection_alist
= Qnil
;
2611 staticpro (&Vselection_alist
);
2613 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2614 doc
: /* An alist associating X Windows selection-types with functions.
2615 These functions are called to convert the selection, with three args:
2616 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2617 a desired type to which the selection should be converted;
2618 and the local selection value (whatever was given to `x-own-selection').
2620 The function should return the value to send to the X server
2621 \(typically a string). A return value of nil
2622 means that the conversion could not be done.
2623 A return value which is the symbol `NULL'
2624 means that a side-effect was executed,
2625 and there is no meaningful selection value. */);
2626 Vselection_converter_alist
= Qnil
;
2628 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2629 doc
: /* A list of functions to be called when Emacs loses an X selection.
2630 \(This happens when some other X client makes its own selection
2631 or when a Lisp program explicitly clears the selection.)
2632 The functions are called with one argument, the selection type
2633 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2634 Vx_lost_selection_functions
= Qnil
;
2636 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2637 doc
: /* A list of functions to be called when Emacs answers a selection request.
2638 The functions are called with four arguments:
2639 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2640 - the selection-type which Emacs was asked to convert the
2641 selection into before sending (for example, `STRING' or `LENGTH');
2642 - a flag indicating success or failure for responding to the request.
2643 We might have failed (and declined the request) for any number of reasons,
2644 including being asked for a selection that we no longer own, or being asked
2645 to convert into a type that we don't know about or that is inappropriate.
2646 This hook doesn't let you change the behavior of Emacs's selection replies,
2647 it merely informs you that they have happened. */);
2648 Vx_sent_selection_functions
= Qnil
;
2650 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2651 doc
: /* Number of milliseconds to wait for a selection reply.
2652 If the selection owner doesn't reply in this time, we give up.
2653 A value of 0 means wait as long as necessary. This is initialized from the
2654 \"*selectionTimeout\" resource. */);
2655 x_selection_timeout
= 0;
2657 /* QPRIMARY is defined in keyboard.c. */
2658 QSECONDARY
= intern_c_string ("SECONDARY"); staticpro (&QSECONDARY
);
2659 QSTRING
= intern_c_string ("STRING"); staticpro (&QSTRING
);
2660 QINTEGER
= intern_c_string ("INTEGER"); staticpro (&QINTEGER
);
2661 QCLIPBOARD
= intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2662 QTIMESTAMP
= intern_c_string ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2663 QTEXT
= intern_c_string ("TEXT"); staticpro (&QTEXT
);
2664 QCOMPOUND_TEXT
= intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2665 QUTF8_STRING
= intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2666 QDELETE
= intern_c_string ("DELETE"); staticpro (&QDELETE
);
2667 QMULTIPLE
= intern_c_string ("MULTIPLE"); staticpro (&QMULTIPLE
);
2668 QINCR
= intern_c_string ("INCR"); staticpro (&QINCR
);
2669 QEMACS_TMP
= intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2670 QTARGETS
= intern_c_string ("TARGETS"); staticpro (&QTARGETS
);
2671 QATOM
= intern_c_string ("ATOM"); staticpro (&QATOM
);
2672 QATOM_PAIR
= intern_c_string ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2673 QNULL
= intern_c_string ("NULL"); staticpro (&QNULL
);
2674 Qcompound_text_with_extensions
= intern_c_string ("compound-text-with-extensions");
2675 staticpro (&Qcompound_text_with_extensions
);
2677 Qforeign_selection
= intern_c_string ("foreign-selection");
2678 staticpro (&Qforeign_selection
);