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
, 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
)))
472 check
= XCDR (value
);
480 /* Check for a value that cons_to_long could handle. */
481 else if (CONSP (check
)
482 && INTEGERP (XCAR (check
))
483 && (INTEGERP (XCDR (check
))
485 (CONSP (XCDR (check
))
486 && INTEGERP (XCAR (XCDR (check
)))
487 && NILP (XCDR (XCDR (check
))))))
490 signal_error ("Invalid data returned by selection-conversion function",
491 list2 (handler_fn
, value
));
494 /* Subroutines of x_reply_selection_request. */
496 /* Send a SelectionNotify event to the requestor with property=None,
497 meaning we were unable to do what they wanted. */
500 x_decline_selection_request (struct input_event
*event
)
502 XSelectionEvent reply
;
504 reply
.type
= SelectionNotify
;
505 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
506 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
507 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
508 reply
.time
= SELECTION_EVENT_TIME (event
);
509 reply
.target
= SELECTION_EVENT_TARGET (event
);
510 reply
.property
= None
;
512 /* The reason for the error may be that the receiver has
513 died in the meantime. Handle that case. */
515 x_catch_errors (reply
.display
);
516 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
517 XFlush (reply
.display
);
522 /* This is the selection request currently being processed.
523 It is set to zero when the request is fully processed. */
524 static struct input_event
*x_selection_current_request
;
526 /* Display info in x_selection_request. */
528 static struct x_display_info
*selection_request_dpyinfo
;
530 /* Used as an unwind-protect clause so that, if a selection-converter signals
531 an error, we tell the requester that we were unable to do what they wanted
532 before we throw to top-level or go into the debugger or whatever. */
535 x_selection_request_lisp_error (Lisp_Object ignore
)
537 if (x_selection_current_request
!= 0
538 && selection_request_dpyinfo
->display
)
539 x_decline_selection_request (x_selection_current_request
);
544 x_catch_errors_unwind (Lisp_Object dummy
)
553 /* This stuff is so that INCR selections are reentrant (that is, so we can
554 be servicing multiple INCR selection requests simultaneously.) I haven't
555 actually tested that yet. */
557 /* Keep a list of the property changes that are awaited. */
567 struct prop_location
*next
;
570 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
571 static void wait_for_property_change (struct prop_location
*location
);
572 static void unexpect_property_change (struct prop_location
*location
);
573 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
575 static int prop_location_identifier
;
577 static Lisp_Object property_change_reply
;
579 static struct prop_location
*property_change_reply_object
;
581 static struct prop_location
*property_change_wait_list
;
584 queue_selection_requests_unwind (Lisp_Object tem
)
586 x_stop_queuing_selection_requests ();
590 /* Return some frame whose display info is DPYINFO.
591 Return nil if there is none. */
594 some_frame_on_display (struct x_display_info
*dpyinfo
)
596 Lisp_Object list
, frame
;
598 FOR_EACH_FRAME (list
, frame
)
600 if (FRAME_X_P (XFRAME (frame
))
601 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
608 /* Send the reply to a selection request event EVENT.
609 TYPE is the type of selection data requested.
610 DATA and SIZE describe the data to send, already converted.
611 FORMAT is the unit-size (in bits) of the data to be transmitted. */
613 #ifdef TRACE_SELECTION
614 static int x_reply_selection_request_cnt
;
615 #endif /* TRACE_SELECTION */
618 x_reply_selection_request (struct input_event
*event
, int format
, unsigned char *data
, int size
, Atom type
)
620 XSelectionEvent reply
;
621 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
622 Window window
= SELECTION_EVENT_REQUESTOR (event
);
624 int format_bytes
= format
/8;
625 int max_bytes
= SELECTION_QUANTUM (display
);
626 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
627 int count
= SPECPDL_INDEX ();
629 if (max_bytes
> MAX_SELECTION_QUANTUM
)
630 max_bytes
= MAX_SELECTION_QUANTUM
;
632 reply
.type
= SelectionNotify
;
633 reply
.display
= display
;
634 reply
.requestor
= window
;
635 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
636 reply
.time
= SELECTION_EVENT_TIME (event
);
637 reply
.target
= SELECTION_EVENT_TARGET (event
);
638 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
639 if (reply
.property
== None
)
640 reply
.property
= reply
.target
;
643 /* The protected block contains wait_for_property_change, which can
644 run random lisp code (process handlers) or signal. Therefore, we
645 put the x_uncatch_errors call in an unwind. */
646 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
647 x_catch_errors (display
);
649 #ifdef TRACE_SELECTION
651 char *sel
= XGetAtomName (display
, reply
.selection
);
652 char *tgt
= XGetAtomName (display
, reply
.target
);
653 TRACE3 ("%s, target %s (%d)", sel
, tgt
, ++x_reply_selection_request_cnt
);
654 if (sel
) XFree (sel
);
655 if (tgt
) XFree (tgt
);
657 #endif /* TRACE_SELECTION */
659 /* Store the data on the requested property.
660 If the selection is large, only store the first N bytes of it.
662 bytes_remaining
= size
* format_bytes
;
663 if (bytes_remaining
<= max_bytes
)
665 /* Send all the data at once, with minimal handshaking. */
666 TRACE1 ("Sending all %d bytes", bytes_remaining
);
667 XChangeProperty (display
, window
, reply
.property
, type
, format
,
668 PropModeReplace
, data
, size
);
669 /* At this point, the selection was successfully stored; ack it. */
670 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
674 /* Send an INCR selection. */
675 struct prop_location
*wait_object
;
679 frame
= some_frame_on_display (dpyinfo
);
681 /* If the display no longer has frames, we can't expect
682 to get many more selection requests from it, so don't
683 bother trying to queue them. */
686 x_start_queuing_selection_requests ();
688 record_unwind_protect (queue_selection_requests_unwind
,
692 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
693 error ("Attempt to transfer an INCR to ourself!");
695 TRACE2 ("Start sending %d bytes incrementally (%s)",
696 bytes_remaining
, XGetAtomName (display
, reply
.property
));
697 wait_object
= expect_property_change (display
, window
, reply
.property
,
700 TRACE1 ("Set %s to number of bytes to send",
701 XGetAtomName (display
, reply
.property
));
703 /* XChangeProperty expects an array of long even if long is more than
707 value
[0] = bytes_remaining
;
708 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
710 (unsigned char *) value
, 1);
713 XSelectInput (display
, window
, PropertyChangeMask
);
715 /* Tell 'em the INCR data is there... */
716 TRACE0 ("Send SelectionNotify event");
717 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
720 had_errors
= x_had_errors_p (display
);
723 /* First, wait for the requester to ack by deleting the property.
724 This can run random lisp code (process handlers) or signal. */
727 TRACE1 ("Waiting for ACK (deletion of %s)",
728 XGetAtomName (display
, reply
.property
));
729 wait_for_property_change (wait_object
);
732 unexpect_property_change (wait_object
);
735 while (bytes_remaining
)
737 int i
= ((bytes_remaining
< max_bytes
)
739 : max_bytes
) / format_bytes
;
744 = expect_property_change (display
, window
, reply
.property
,
747 TRACE1 ("Sending increment of %d elements", i
);
748 TRACE1 ("Set %s to increment data",
749 XGetAtomName (display
, reply
.property
));
751 /* Append the next chunk of data to the property. */
752 XChangeProperty (display
, window
, reply
.property
, type
, format
,
753 PropModeAppend
, data
, i
);
754 bytes_remaining
-= i
* format_bytes
;
756 data
+= i
* sizeof (long);
758 data
+= i
* format_bytes
;
760 had_errors
= x_had_errors_p (display
);
766 /* Now wait for the requester to ack this chunk by deleting the
767 property. This can run random lisp code or signal. */
768 TRACE1 ("Waiting for increment ACK (deletion of %s)",
769 XGetAtomName (display
, reply
.property
));
770 wait_for_property_change (wait_object
);
773 /* Now write a zero-length chunk to the property to tell the
774 requester that we're done. */
776 if (! waiting_for_other_props_on_window (display
, window
))
777 XSelectInput (display
, window
, 0L);
779 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
780 XGetAtomName (display
, reply
.property
));
781 XChangeProperty (display
, window
, reply
.property
, type
, format
,
782 PropModeReplace
, data
, 0);
783 TRACE0 ("Done sending incrementally");
786 /* rms, 2003-01-03: I think I have fixed this bug. */
787 /* The window we're communicating with may have been deleted
788 in the meantime (that's a real situation from a bug report).
789 In this case, there may be events in the event queue still
790 refering to the deleted window, and we'll get a BadWindow error
791 in XTread_socket when processing the events. I don't have
792 an idea how to fix that. gerd, 2001-01-98. */
793 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
794 delivered before uncatch errors. */
795 XSync (display
, False
);
798 /* GTK queues events in addition to the queue in Xlib. So we
799 UNBLOCK to enter the event loop and get possible errors delivered,
800 and then BLOCK again because x_uncatch_errors requires it. */
802 /* This calls x_uncatch_errors. */
803 unbind_to (count
, Qnil
);
807 /* Handle a SelectionRequest event EVENT.
808 This is called from keyboard.c when such an event is found in the queue. */
811 x_handle_selection_request (struct input_event
*event
)
813 struct gcpro gcpro1
, gcpro2
, gcpro3
;
814 Lisp_Object local_selection_data
;
815 Lisp_Object selection_symbol
;
816 Lisp_Object target_symbol
;
817 Lisp_Object converted_selection
;
818 Time local_selection_time
;
819 Lisp_Object successful_p
;
821 struct x_display_info
*dpyinfo
822 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
824 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
825 (unsigned long) SELECTION_EVENT_REQUESTOR (event
),
826 (unsigned long) SELECTION_EVENT_TIME (event
));
828 local_selection_data
= Qnil
;
829 target_symbol
= Qnil
;
830 converted_selection
= Qnil
;
833 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
835 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
836 SELECTION_EVENT_SELECTION (event
));
838 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
840 if (NILP (local_selection_data
))
842 /* Someone asked for the selection, but we don't have it any more.
844 x_decline_selection_request (event
);
848 local_selection_time
= (Time
)
849 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
851 if (SELECTION_EVENT_TIME (event
) != CurrentTime
852 && local_selection_time
> SELECTION_EVENT_TIME (event
))
854 /* Someone asked for the selection, and we have one, but not the one
857 x_decline_selection_request (event
);
861 x_selection_current_request
= event
;
862 count
= SPECPDL_INDEX ();
863 selection_request_dpyinfo
= dpyinfo
;
864 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
866 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
867 SELECTION_EVENT_TARGET (event
));
869 #if 0 /* #### MULTIPLE doesn't work yet */
870 if (EQ (target_symbol
, QMULTIPLE
))
871 target_symbol
= fetch_multiple_target (event
);
874 /* Convert lisp objects back into binary data */
877 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
879 if (! NILP (converted_selection
))
887 if (CONSP (converted_selection
) && NILP (XCDR (converted_selection
)))
889 x_decline_selection_request (event
);
893 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
895 &data
, &type
, &size
, &format
, &nofree
);
897 x_reply_selection_request (event
, format
, data
, size
, type
);
900 /* Indicate we have successfully processed this event. */
901 x_selection_current_request
= 0;
903 /* Use xfree, not XFree, because lisp_data_to_selection_data
904 calls xmalloc itself. */
910 unbind_to (count
, Qnil
);
914 /* Let random lisp code notice that the selection has been asked for. */
917 rest
= Vx_sent_selection_functions
;
918 if (!EQ (rest
, Qunbound
))
919 for (; CONSP (rest
); rest
= Fcdr (rest
))
920 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
926 /* Handle a SelectionClear event EVENT, which indicates that some
927 client cleared out our previously asserted selection.
928 This is called from keyboard.c when such an event is found in the queue. */
931 x_handle_selection_clear (struct input_event
*event
)
933 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
934 Atom selection
= SELECTION_EVENT_SELECTION (event
);
935 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
937 Lisp_Object selection_symbol
, local_selection_data
;
938 Time local_selection_time
;
939 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
940 struct x_display_info
*t_dpyinfo
;
942 TRACE0 ("x_handle_selection_clear");
944 /* If the new selection owner is also Emacs,
945 don't clear the new selection. */
947 /* Check each display on the same terminal,
948 to see if this Emacs job now owns the selection
949 through that display. */
950 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
951 if (t_dpyinfo
->terminal
->kboard
== dpyinfo
->terminal
->kboard
)
954 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
955 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
963 selection_symbol
= x_atom_to_symbol (display
, selection
);
965 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
967 /* Well, we already believe that we don't own it, so that's just fine. */
968 if (NILP (local_selection_data
)) return;
970 local_selection_time
= (Time
)
971 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
973 /* This SelectionClear is for a selection that we no longer own, so we can
974 disregard it. (That is, we have reasserted the selection since this
975 request was generated.) */
977 if (changed_owner_time
!= CurrentTime
978 && local_selection_time
> changed_owner_time
)
981 /* Otherwise, we're really honest and truly being told to drop it.
982 Don't use Fdelq as that may QUIT;. */
984 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
985 Vselection_alist
= Fcdr (Vselection_alist
);
989 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
990 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
992 XSETCDR (rest
, Fcdr (XCDR (rest
)));
997 /* Let random lisp code notice that the selection has been stolen. */
1001 rest
= Vx_lost_selection_functions
;
1002 if (!EQ (rest
, Qunbound
))
1004 for (; CONSP (rest
); rest
= Fcdr (rest
))
1005 call1 (Fcar (rest
), selection_symbol
);
1006 prepare_menu_bars ();
1007 redisplay_preserve_echo_area (20);
1013 x_handle_selection_event (struct input_event
*event
)
1015 TRACE0 ("x_handle_selection_event");
1017 if (event
->kind
== SELECTION_REQUEST_EVENT
)
1019 if (x_queue_selection_requests
)
1020 x_queue_event (event
);
1022 x_handle_selection_request (event
);
1025 x_handle_selection_clear (event
);
1029 /* Clear all selections that were made from frame F.
1030 We do this when about to delete a frame. */
1033 x_clear_frame_selections (FRAME_PTR f
)
1038 XSETFRAME (frame
, f
);
1040 /* Otherwise, we're really honest and truly being told to drop it.
1041 Don't use Fdelq as that may QUIT;. */
1043 /* Delete elements from the beginning of Vselection_alist. */
1044 while (!NILP (Vselection_alist
)
1045 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1047 /* Let random Lisp code notice that the selection has been stolen. */
1048 Lisp_Object hooks
, selection_symbol
;
1050 hooks
= Vx_lost_selection_functions
;
1051 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1053 if (!EQ (hooks
, Qunbound
))
1055 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1056 call1 (Fcar (hooks
), selection_symbol
);
1057 #if 0 /* This can crash when deleting a frame
1058 from x_connection_closed. Anyway, it seems unnecessary;
1059 something else should cause a redisplay. */
1060 redisplay_preserve_echo_area (21);
1064 Vselection_alist
= Fcdr (Vselection_alist
);
1067 /* Delete elements after the beginning of Vselection_alist. */
1068 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1069 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1071 /* Let random Lisp code notice that the selection has been stolen. */
1072 Lisp_Object hooks
, selection_symbol
;
1074 hooks
= Vx_lost_selection_functions
;
1075 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1077 if (!EQ (hooks
, Qunbound
))
1079 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1080 call1 (Fcar (hooks
), selection_symbol
);
1081 #if 0 /* See above */
1082 redisplay_preserve_echo_area (22);
1085 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1090 /* Nonzero if any properties for DISPLAY and WINDOW
1091 are on the list of what we are waiting for. */
1094 waiting_for_other_props_on_window (Display
*display
, Window window
)
1096 struct prop_location
*rest
= property_change_wait_list
;
1098 if (rest
->display
== display
&& rest
->window
== window
)
1105 /* Add an entry to the list of property changes we are waiting for.
1106 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1107 The return value is a number that uniquely identifies
1108 this awaited property change. */
1110 static struct prop_location
*
1111 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1113 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1114 pl
->identifier
= ++prop_location_identifier
;
1115 pl
->display
= display
;
1116 pl
->window
= window
;
1117 pl
->property
= property
;
1118 pl
->desired_state
= state
;
1119 pl
->next
= property_change_wait_list
;
1121 property_change_wait_list
= pl
;
1125 /* Delete an entry from the list of property changes we are waiting for.
1126 IDENTIFIER is the number that uniquely identifies the entry. */
1129 unexpect_property_change (struct prop_location
*location
)
1131 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1134 if (rest
== location
)
1137 prev
->next
= rest
->next
;
1139 property_change_wait_list
= rest
->next
;
1148 /* Remove the property change expectation element for IDENTIFIER. */
1151 wait_for_property_change_unwind (Lisp_Object loc
)
1153 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1155 unexpect_property_change (location
);
1156 if (location
== property_change_reply_object
)
1157 property_change_reply_object
= 0;
1161 /* Actually wait for a property change.
1162 IDENTIFIER should be the value that expect_property_change returned. */
1165 wait_for_property_change (struct prop_location
*location
)
1168 int count
= SPECPDL_INDEX ();
1170 if (property_change_reply_object
)
1173 /* Make sure to do unexpect_property_change if we quit or err. */
1174 record_unwind_protect (wait_for_property_change_unwind
,
1175 make_save_value (location
, 0));
1177 XSETCAR (property_change_reply
, Qnil
);
1178 property_change_reply_object
= location
;
1180 /* If the event we are waiting for arrives beyond here, it will set
1181 property_change_reply, because property_change_reply_object says so. */
1182 if (! location
->arrived
)
1184 secs
= x_selection_timeout
/ 1000;
1185 usecs
= (x_selection_timeout
% 1000) * 1000;
1186 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1187 wait_reading_process_output (secs
, usecs
, 0, 0,
1188 property_change_reply
, NULL
, 0);
1190 if (NILP (XCAR (property_change_reply
)))
1192 TRACE0 (" Timed out");
1193 error ("Timed out waiting for property-notify event");
1197 unbind_to (count
, Qnil
);
1200 /* Called from XTread_socket in response to a PropertyNotify event. */
1203 x_handle_property_notify (XPropertyEvent
*event
)
1205 struct prop_location
*rest
;
1207 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1210 && rest
->property
== event
->atom
1211 && rest
->window
== event
->window
1212 && rest
->display
== event
->display
1213 && rest
->desired_state
== event
->state
)
1215 TRACE2 ("Expected %s of property %s",
1216 (event
->state
== PropertyDelete
? "deletion" : "change"),
1217 XGetAtomName (event
->display
, event
->atom
));
1221 /* If this is the one wait_for_property_change is waiting for,
1222 tell it to wake up. */
1223 if (rest
== property_change_reply_object
)
1224 XSETCAR (property_change_reply
, Qt
);
1233 #if 0 /* #### MULTIPLE doesn't work yet */
1236 fetch_multiple_target (event
)
1237 XSelectionRequestEvent
*event
;
1239 Display
*display
= event
->display
;
1240 Window window
= event
->requestor
;
1241 Atom target
= event
->target
;
1242 Atom selection_atom
= event
->selection
;
1247 x_get_window_property_as_lisp_data (display
, window
, target
,
1248 QMULTIPLE
, selection_atom
));
1252 copy_multiple_data (obj
)
1259 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1262 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1263 for (i
= 0; i
< size
; i
++)
1265 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1266 CHECK_VECTOR (vec2
);
1267 if (XVECTOR (vec2
)->size
!= 2)
1268 /* ??? Confusing error message */
1269 signal_error ("Vectors must be of length 2", vec2
);
1270 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1271 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1272 = XVECTOR (vec2
)->contents
[0];
1273 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1274 = XVECTOR (vec2
)->contents
[1];
1282 /* Variables for communication with x_handle_selection_notify. */
1283 static Atom reading_which_selection
;
1284 static Lisp_Object reading_selection_reply
;
1285 static Window reading_selection_window
;
1287 /* Do protocol to read selection-data from the server.
1288 Converts this to Lisp data and returns it. */
1291 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
1293 struct frame
*sf
= SELECTED_FRAME ();
1294 Window requestor_window
;
1296 struct x_display_info
*dpyinfo
;
1297 Time requestor_time
= last_event_timestamp
;
1298 Atom target_property
;
1299 Atom selection_atom
;
1302 int count
= SPECPDL_INDEX ();
1305 if (! FRAME_X_P (sf
))
1308 requestor_window
= FRAME_X_WINDOW (sf
);
1309 display
= FRAME_X_DISPLAY (sf
);
1310 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1311 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1312 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1314 if (CONSP (target_type
))
1315 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1317 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1319 if (! NILP (time_stamp
))
1321 if (CONSP (time_stamp
))
1322 requestor_time
= (Time
) cons_to_long (time_stamp
);
1323 else if (INTEGERP (time_stamp
))
1324 requestor_time
= (Time
) XUINT (time_stamp
);
1325 else if (FLOATP (time_stamp
))
1326 requestor_time
= (Time
) XFLOAT_DATA (time_stamp
);
1328 error ("TIME_STAMP must be cons or number");
1333 /* The protected block contains wait_reading_process_output, which
1334 can run random lisp code (process handlers) or signal.
1335 Therefore, we put the x_uncatch_errors call in an unwind. */
1336 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
1337 x_catch_errors (display
);
1339 TRACE2 ("Get selection %s, type %s",
1340 XGetAtomName (display
, type_atom
),
1341 XGetAtomName (display
, target_property
));
1343 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1344 requestor_window
, requestor_time
);
1347 /* Prepare to block until the reply has been read. */
1348 reading_selection_window
= requestor_window
;
1349 reading_which_selection
= selection_atom
;
1350 XSETCAR (reading_selection_reply
, Qnil
);
1352 frame
= some_frame_on_display (dpyinfo
);
1354 /* If the display no longer has frames, we can't expect
1355 to get many more selection requests from it, so don't
1356 bother trying to queue them. */
1359 x_start_queuing_selection_requests ();
1361 record_unwind_protect (queue_selection_requests_unwind
,
1366 /* This allows quits. Also, don't wait forever. */
1367 secs
= x_selection_timeout
/ 1000;
1368 usecs
= (x_selection_timeout
% 1000) * 1000;
1369 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1370 wait_reading_process_output (secs
, usecs
, 0, 0,
1371 reading_selection_reply
, NULL
, 0);
1372 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1375 if (x_had_errors_p (display
))
1376 error ("Cannot get selection");
1377 /* This calls x_uncatch_errors. */
1378 unbind_to (count
, Qnil
);
1381 if (NILP (XCAR (reading_selection_reply
)))
1382 error ("Timed out waiting for reply from selection owner");
1383 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1386 /* Otherwise, the selection is waiting for us on the requested property. */
1388 x_get_window_property_as_lisp_data (display
, requestor_window
,
1389 target_property
, target_type
,
1393 /* Subroutines of x_get_window_property_as_lisp_data */
1395 /* Use xfree, not XFree, to free the data obtained with this function. */
1398 x_get_window_property (Display
*display
, Window window
, Atom property
,
1399 unsigned char **data_ret
, int *bytes_ret
,
1400 Atom
*actual_type_ret
, int *actual_format_ret
,
1401 unsigned long *actual_size_ret
, int delete_p
)
1404 unsigned long bytes_remaining
;
1406 unsigned char *tmp_data
= 0;
1408 int buffer_size
= SELECTION_QUANTUM (display
);
1410 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1411 buffer_size
= MAX_SELECTION_QUANTUM
;
1415 /* First probe the thing to find out how big it is. */
1416 result
= XGetWindowProperty (display
, window
, property
,
1417 0L, 0L, False
, AnyPropertyType
,
1418 actual_type_ret
, actual_format_ret
,
1420 &bytes_remaining
, &tmp_data
);
1421 if (result
!= Success
)
1429 /* This was allocated by Xlib, so use XFree. */
1430 XFree ((char *) tmp_data
);
1432 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1438 total_size
= bytes_remaining
+ 1;
1439 *data_ret
= (unsigned char *) xmalloc (total_size
);
1441 /* Now read, until we've gotten it all. */
1442 while (bytes_remaining
)
1444 #ifdef TRACE_SELECTION
1445 int last
= bytes_remaining
;
1448 = XGetWindowProperty (display
, window
, property
,
1449 (long)offset
/4, (long)buffer_size
/4,
1452 actual_type_ret
, actual_format_ret
,
1453 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1455 TRACE2 ("Read %ld bytes from property %s",
1456 last
- bytes_remaining
,
1457 XGetAtomName (display
, property
));
1459 /* If this doesn't return Success at this point, it means that
1460 some clod deleted the selection while we were in the midst of
1461 reading it. Deal with that, I guess.... */
1462 if (result
!= Success
)
1465 /* The man page for XGetWindowProperty says:
1466 "If the returned format is 32, the returned data is represented
1467 as a long array and should be cast to that type to obtain the
1469 This applies even if long is more than 32 bits, the X library
1470 converts from 32 bit elements received from the X server to long
1471 and passes the long array to us. Thus, for that case memcpy can not
1472 be used. We convert to a 32 bit type here, because so much code
1475 The bytes and offsets passed to XGetWindowProperty refers to the
1476 property and those are indeed in 32 bit quantities if format is 32. */
1478 if (*actual_format_ret
== 32 && *actual_format_ret
< BITS_PER_LONG
)
1481 int *idata
= (int *) ((*data_ret
) + offset
);
1482 long *ldata
= (long *) tmp_data
;
1484 for (i
= 0; i
< *actual_size_ret
; ++i
)
1486 idata
[i
]= (int) ldata
[i
];
1492 *actual_size_ret
*= *actual_format_ret
/ 8;
1493 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1494 offset
+= *actual_size_ret
;
1497 /* This was allocated by Xlib, so use XFree. */
1498 XFree ((char *) tmp_data
);
1503 *bytes_ret
= offset
;
1506 /* Use xfree, not XFree, to free the data obtained with this function. */
1509 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1510 Lisp_Object target_type
,
1511 unsigned int min_size_bytes
,
1512 unsigned char **data_ret
, int *size_bytes_ret
,
1513 Atom
*type_ret
, int *format_ret
,
1514 unsigned long *size_ret
)
1517 struct prop_location
*wait_object
;
1518 *size_bytes_ret
= min_size_bytes
;
1519 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1521 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1523 /* At this point, we have read an INCR property.
1524 Delete the property to ack it.
1525 (But first, prepare to receive the next event in this handshake.)
1527 Now, we must loop, waiting for the sending window to put a value on
1528 that property, then reading the property, then deleting it to ack.
1529 We are done when the sender places a property of length 0.
1532 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1533 TRACE1 (" Delete property %s",
1534 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1535 XDeleteProperty (display
, window
, property
);
1536 TRACE1 (" Expect new value of property %s",
1537 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1538 wait_object
= expect_property_change (display
, window
, property
,
1545 unsigned char *tmp_data
;
1548 TRACE0 (" Wait for property change");
1549 wait_for_property_change (wait_object
);
1551 /* expect it again immediately, because x_get_window_property may
1552 .. no it won't, I don't get it.
1553 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1554 TRACE0 (" Get property value");
1555 x_get_window_property (display
, window
, property
,
1556 &tmp_data
, &tmp_size_bytes
,
1557 type_ret
, format_ret
, size_ret
, 1);
1559 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1561 if (tmp_size_bytes
== 0) /* we're done */
1563 TRACE0 ("Done reading incrementally");
1565 if (! waiting_for_other_props_on_window (display
, window
))
1566 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1567 /* Use xfree, not XFree, because x_get_window_property
1568 calls xmalloc itself. */
1574 TRACE1 (" ACK by deleting property %s",
1575 XGetAtomName (display
, property
));
1576 XDeleteProperty (display
, window
, property
);
1577 wait_object
= expect_property_change (display
, window
, property
,
1582 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1584 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1585 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1588 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1589 offset
+= tmp_size_bytes
;
1591 /* Use xfree, not XFree, because x_get_window_property
1592 calls xmalloc itself. */
1598 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1599 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1600 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1603 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1605 Lisp_Object target_type
,
1606 Atom selection_atom
)
1610 unsigned long actual_size
;
1611 unsigned char *data
= 0;
1614 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1616 TRACE0 ("Reading selection data");
1618 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1619 &actual_type
, &actual_format
, &actual_size
, 1);
1622 int there_is_a_selection_owner
;
1624 there_is_a_selection_owner
1625 = XGetSelectionOwner (display
, selection_atom
);
1627 if (there_is_a_selection_owner
)
1628 signal_error ("Selection owner couldn't convert",
1630 ? list2 (target_type
,
1631 x_atom_to_symbol (display
, actual_type
))
1634 signal_error ("No selection",
1635 x_atom_to_symbol (display
, selection_atom
));
1638 if (actual_type
== dpyinfo
->Xatom_INCR
)
1640 /* That wasn't really the data, just the beginning. */
1642 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1644 /* Use xfree, not XFree, because x_get_window_property
1645 calls xmalloc itself. */
1646 xfree ((char *) data
);
1648 receive_incremental_selection (display
, window
, property
, target_type
,
1649 min_size_bytes
, &data
, &bytes
,
1650 &actual_type
, &actual_format
,
1655 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1656 XDeleteProperty (display
, window
, property
);
1660 /* It's been read. Now convert it to a lisp object in some semi-rational
1662 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1663 actual_type
, actual_format
);
1665 /* Use xfree, not XFree, because x_get_window_property
1666 calls xmalloc itself. */
1667 xfree ((char *) data
);
1671 /* These functions convert from the selection data read from the server into
1672 something that we can use from Lisp, and vice versa.
1674 Type: Format: Size: Lisp Type:
1675 ----- ------- ----- -----------
1678 ATOM 32 > 1 Vector of Symbols
1680 * 16 > 1 Vector of Integers
1681 * 32 1 if <=16 bits: Integer
1682 if > 16 bits: Cons of top16, bot16
1683 * 32 > 1 Vector of the above
1685 When converting a Lisp number to C, it is assumed to be of format 16 if
1686 it is an integer, and of format 32 if it is a cons of two integers.
1688 When converting a vector of numbers from Lisp to C, it is assumed to be
1689 of format 16 if every element in the vector is an integer, and is assumed
1690 to be of format 32 if any element is a cons of two integers.
1692 When converting an object to C, it may be of the form (SYMBOL . <data>)
1693 where SYMBOL is what we should claim that the type is. Format and
1694 representation are as above.
1696 Important: When format is 32, data should contain an array of int,
1697 not an array of long as the X library returns. This makes a difference
1698 when sizeof(long) != sizeof(int). */
1703 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1704 int size
, Atom type
, int format
)
1706 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1708 if (type
== dpyinfo
->Xatom_NULL
)
1711 /* Convert any 8-bit data to a string, for compactness. */
1712 else if (format
== 8)
1714 Lisp_Object str
, lispy_type
;
1716 str
= make_unibyte_string ((char *) data
, size
);
1717 /* Indicate that this string is from foreign selection by a text
1718 property `foreign-selection' so that the caller of
1719 x-get-selection-internal (usually x-get-selection) can know
1720 that the string must be decode. */
1721 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1722 lispy_type
= QCOMPOUND_TEXT
;
1723 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1724 lispy_type
= QUTF8_STRING
;
1726 lispy_type
= QSTRING
;
1727 Fput_text_property (make_number (0), make_number (size
),
1728 Qforeign_selection
, lispy_type
, str
);
1731 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1732 a vector of symbols.
1734 else if (type
== XA_ATOM
)
1737 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1738 But the callers of these function has made sure the data for
1739 format == 32 is an array of int. Thus, use int instead
1741 int *idata
= (int *) data
;
1743 if (size
== sizeof (int))
1744 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1747 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1749 for (i
= 0; i
< size
/ sizeof (int); i
++)
1750 Faset (v
, make_number (i
),
1751 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1756 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1757 If the number is 32 bits and won't fit in a Lisp_Int,
1758 convert it to a cons of integers, 16 bits in each half.
1760 else if (format
== 32 && size
== sizeof (int))
1761 return long_to_cons (((unsigned int *) data
) [0]);
1762 else if (format
== 16 && size
== sizeof (short))
1763 return make_number ((int) (((unsigned short *) data
) [0]));
1765 /* Convert any other kind of data to a vector of numbers, represented
1766 as above (as an integer, or a cons of two 16 bit integers.)
1768 else if (format
== 16)
1772 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1773 for (i
= 0; i
< size
/ 2; i
++)
1775 int j
= (int) ((unsigned short *) data
) [i
];
1776 Faset (v
, make_number (i
), make_number (j
));
1783 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1784 for (i
= 0; i
< size
/ 4; i
++)
1786 unsigned int j
= ((unsigned int *) data
) [i
];
1787 Faset (v
, make_number (i
), long_to_cons (j
));
1794 /* Use xfree, not XFree, to free the data obtained with this function. */
1797 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1798 unsigned char **data_ret
, Atom
*type_ret
,
1799 unsigned int *size_ret
,
1800 int *format_ret
, int *nofree_ret
)
1802 Lisp_Object type
= Qnil
;
1803 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1807 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1811 if (CONSP (obj
) && NILP (XCDR (obj
)))
1815 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1816 { /* This is not the same as declining */
1822 else if (STRINGP (obj
))
1824 if (SCHARS (obj
) < SBYTES (obj
))
1825 /* OBJ is a multibyte string containing a non-ASCII char. */
1826 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1830 *size_ret
= SBYTES (obj
);
1831 *data_ret
= SDATA (obj
);
1834 else if (SYMBOLP (obj
))
1838 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1839 (*data_ret
) [sizeof (Atom
)] = 0;
1840 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1841 if (NILP (type
)) type
= QATOM
;
1843 else if (INTEGERP (obj
)
1844 && XINT (obj
) < 0xFFFF
1845 && XINT (obj
) > -0xFFFF)
1849 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1850 (*data_ret
) [sizeof (short)] = 0;
1851 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1852 if (NILP (type
)) type
= QINTEGER
;
1854 else if (INTEGERP (obj
)
1855 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1856 && (INTEGERP (XCDR (obj
))
1857 || (CONSP (XCDR (obj
))
1858 && INTEGERP (XCAR (XCDR (obj
)))))))
1862 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1863 (*data_ret
) [sizeof (long)] = 0;
1864 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1865 if (NILP (type
)) type
= QINTEGER
;
1867 else if (VECTORP (obj
))
1869 /* Lisp_Vectors may represent a set of ATOMs;
1870 a set of 16 or 32 bit INTEGERs;
1871 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1875 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1876 /* This vector is an ATOM set */
1878 if (NILP (type
)) type
= QATOM
;
1879 *size_ret
= XVECTOR (obj
)->size
;
1881 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1882 for (i
= 0; i
< *size_ret
; i
++)
1883 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1884 (*(Atom
**) data_ret
) [i
]
1885 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1887 signal_error ("All elements of selection vector must have same type", obj
);
1889 #if 0 /* #### MULTIPLE doesn't work yet */
1890 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1891 /* This vector is an ATOM_PAIR set */
1893 if (NILP (type
)) type
= QATOM_PAIR
;
1894 *size_ret
= XVECTOR (obj
)->size
;
1896 *data_ret
= (unsigned char *)
1897 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1898 for (i
= 0; i
< *size_ret
; i
++)
1899 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1901 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1902 if (XVECTOR (pair
)->size
!= 2)
1904 "Elements of the vector must be vectors of exactly two elements",
1907 (*(Atom
**) data_ret
) [i
* 2]
1908 = symbol_to_x_atom (dpyinfo
, display
,
1909 XVECTOR (pair
)->contents
[0]);
1910 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1911 = symbol_to_x_atom (dpyinfo
, display
,
1912 XVECTOR (pair
)->contents
[1]);
1915 signal_error ("All elements of the vector must be of the same type",
1921 /* This vector is an INTEGER set, or something like it */
1924 *size_ret
= XVECTOR (obj
)->size
;
1925 if (NILP (type
)) type
= QINTEGER
;
1927 for (i
= 0; i
< *size_ret
; i
++)
1928 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1930 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1931 signal_error (/* Qselection_error */
1932 "Elements of selection vector must be integers or conses of integers",
1935 /* Use sizeof(long) even if it is more than 32 bits. See comment
1936 in x_get_window_property and x_fill_property_data. */
1938 if (*format_ret
== 32) data_size
= sizeof(long);
1939 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1940 for (i
= 0; i
< *size_ret
; i
++)
1941 if (*format_ret
== 32)
1942 (*((unsigned long **) data_ret
)) [i
]
1943 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1945 (*((unsigned short **) data_ret
)) [i
]
1946 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1950 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1952 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1956 clean_local_selection_data (Lisp_Object obj
)
1959 && INTEGERP (XCAR (obj
))
1960 && CONSP (XCDR (obj
))
1961 && INTEGERP (XCAR (XCDR (obj
)))
1962 && NILP (XCDR (XCDR (obj
))))
1963 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1966 && INTEGERP (XCAR (obj
))
1967 && INTEGERP (XCDR (obj
)))
1969 if (XINT (XCAR (obj
)) == 0)
1971 if (XINT (XCAR (obj
)) == -1)
1972 return make_number (- XINT (XCDR (obj
)));
1977 int size
= XVECTOR (obj
)->size
;
1980 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1981 copy
= Fmake_vector (make_number (size
), Qnil
);
1982 for (i
= 0; i
< size
; i
++)
1983 XVECTOR (copy
)->contents
[i
]
1984 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1990 /* Called from XTread_socket to handle SelectionNotify events.
1991 If it's the selection we are waiting for, stop waiting
1992 by setting the car of reading_selection_reply to non-nil.
1993 We store t there if the reply is successful, lambda if not. */
1996 x_handle_selection_notify (XSelectionEvent
*event
)
1998 if (event
->requestor
!= reading_selection_window
)
2000 if (event
->selection
!= reading_which_selection
)
2003 TRACE0 ("Received SelectionNotify");
2004 XSETCAR (reading_selection_reply
,
2005 (event
->property
!= 0 ? Qt
: Qlambda
));
2009 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
2010 Sx_own_selection_internal
, 2, 2, 0,
2011 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
2012 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2013 \(Those are literal upper-case symbol names, since that's what X expects.)
2014 VALUE is typically a string, or a cons of two markers, but may be
2015 anything that the functions on `selection-converter-alist' know about. */)
2016 (Lisp_Object selection_name
, Lisp_Object selection_value
)
2019 CHECK_SYMBOL (selection_name
);
2020 if (NILP (selection_value
)) error ("SELECTION-VALUE may not be nil");
2021 x_own_selection (selection_name
, selection_value
);
2022 return selection_value
;
2026 /* Request the selection value from the owner. If we are the owner,
2027 simply return our selection value. If we are not the owner, this
2028 will block until all of the data has arrived. */
2030 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2031 Sx_get_selection_internal
, 2, 3, 0,
2032 doc
: /* Return text selected from some X window.
2033 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2034 \(Those are literal upper-case symbol names, since that's what X expects.)
2035 TYPE is the type of data desired, typically `STRING'.
2036 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2037 selections. If omitted, defaults to the time for the last event. */)
2038 (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
2040 Lisp_Object val
= Qnil
;
2041 struct gcpro gcpro1
, gcpro2
;
2042 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2044 CHECK_SYMBOL (selection_symbol
);
2046 #if 0 /* #### MULTIPLE doesn't work yet */
2047 if (CONSP (target_type
)
2048 && XCAR (target_type
) == QMULTIPLE
)
2050 CHECK_VECTOR (XCDR (target_type
));
2051 /* So we don't destructively modify this... */
2052 target_type
= copy_multiple_data (target_type
);
2056 CHECK_SYMBOL (target_type
);
2058 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2062 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
2067 && SYMBOLP (XCAR (val
)))
2070 if (CONSP (val
) && NILP (XCDR (val
)))
2073 val
= clean_local_selection_data (val
);
2079 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2080 Sx_disown_selection_internal
, 1, 2, 0,
2081 doc
: /* If we own the selection SELECTION, disown it.
2082 Disowning it means there is no such selection. */)
2083 (Lisp_Object selection
, Lisp_Object time_object
)
2086 Atom selection_atom
;
2088 struct selection_input_event sie
;
2089 struct input_event ie
;
2092 struct x_display_info
*dpyinfo
;
2093 struct frame
*sf
= SELECTED_FRAME ();
2096 if (! FRAME_X_P (sf
))
2099 display
= FRAME_X_DISPLAY (sf
);
2100 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2101 CHECK_SYMBOL (selection
);
2102 if (NILP (time_object
))
2103 timestamp
= last_event_timestamp
;
2105 timestamp
= cons_to_long (time_object
);
2107 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2108 return Qnil
; /* Don't disown the selection when we're not the owner. */
2110 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2113 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2116 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2117 generated for a window which owns the selection when that window sets
2118 the selection owner to None. The NCD server does, the MIT Sun4 server
2119 doesn't. So we synthesize one; this means we might get two, but
2120 that's ok, because the second one won't have any effect. */
2121 SELECTION_EVENT_DISPLAY (&event
.sie
) = display
;
2122 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2123 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2124 x_handle_selection_clear (&event
.ie
);
2129 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2131 doc
: /* Whether the current Emacs process owns the given X Selection.
2132 The arg should be the name of the selection in question, typically one of
2133 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2134 \(Those are literal upper-case symbol names, since that's what X expects.)
2135 For convenience, the symbol nil is the same as `PRIMARY',
2136 and t is the same as `SECONDARY'. */)
2137 (Lisp_Object selection
)
2140 CHECK_SYMBOL (selection
);
2141 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2142 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2144 if (NILP (Fassq (selection
, Vselection_alist
)))
2149 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2151 doc
: /* Whether there is an owner for the given X Selection.
2152 The arg should be the name of the selection in question, typically one of
2153 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2154 \(Those are literal upper-case symbol names, since that's what X expects.)
2155 For convenience, the symbol nil is the same as `PRIMARY',
2156 and t is the same as `SECONDARY'. */)
2157 (Lisp_Object selection
)
2162 struct frame
*sf
= SELECTED_FRAME ();
2164 /* It should be safe to call this before we have an X frame. */
2165 if (! FRAME_X_P (sf
))
2168 dpy
= FRAME_X_DISPLAY (sf
);
2169 CHECK_SYMBOL (selection
);
2170 if (!NILP (Fx_selection_owner_p (selection
)))
2172 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2173 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2174 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2178 owner
= XGetSelectionOwner (dpy
, atom
);
2180 return (owner
? Qt
: Qnil
);
2184 /***********************************************************************
2185 Drag and drop support
2186 ***********************************************************************/
2187 /* Check that lisp values are of correct type for x_fill_property_data.
2188 That is, number, string or a cons with two numbers (low and high 16
2189 bit parts of a 32 bit number). Return the number of items in DATA,
2190 or -1 if there is an error. */
2193 x_check_property_data (Lisp_Object data
)
2198 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2200 Lisp_Object o
= XCAR (iter
);
2202 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2204 else if (CONSP (o
) &&
2205 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2213 /* Convert lisp values to a C array. Values may be a number, a string
2214 which is taken as an X atom name and converted to the atom value, or
2215 a cons containing the two 16 bit parts of a 32 bit number.
2217 DPY is the display use to look up X atoms.
2218 DATA is a Lisp list of values to be converted.
2219 RET is the C array that contains the converted values. It is assumed
2220 it is big enough to hold all values.
2221 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2222 be stored in RET. Note that long is used for 32 even if long is more
2223 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2224 XClientMessageEvent). */
2227 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2230 long *d32
= (long *) ret
;
2231 short *d16
= (short *) ret
;
2232 char *d08
= (char *) ret
;
2235 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2237 Lisp_Object o
= XCAR (iter
);
2240 val
= (long) XFASTINT (o
);
2241 else if (FLOATP (o
))
2242 val
= (long) XFLOAT_DATA (o
);
2244 val
= (long) cons_to_long (o
);
2245 else if (STRINGP (o
))
2248 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2252 error ("Wrong type, must be string, number or cons");
2255 *d08
++ = (char) val
;
2256 else if (format
== 16)
2257 *d16
++ = (short) val
;
2263 /* Convert an array of C values to a Lisp list.
2264 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2265 DATA is a C array of values to be converted.
2266 TYPE is the type of the data. Only XA_ATOM is special, it converts
2267 each number in DATA to its corresponfing X atom as a symbol.
2268 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2270 SIZE is the number of elements in DATA.
2272 Important: When format is 32, data should contain an array of int,
2273 not an array of long as the X library returns. This makes a difference
2274 when sizeof(long) != sizeof(int).
2276 Also see comment for selection_data_to_lisp_data above. */
2279 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2280 Atom type
, int format
, long unsigned int size
)
2282 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2283 data
, size
*format
/8, type
, format
);
2286 /* Get the mouse position in frame relative coordinates. */
2289 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2291 Window root
, dummy_window
;
2296 XQueryPointer (FRAME_X_DISPLAY (f
),
2297 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2299 /* The root window which contains the pointer. */
2302 /* Window pointer is on, not used */
2305 /* The position on that root window. */
2308 /* x/y in dummy_window coordinates, not used. */
2311 /* Modifier keys and pointer buttons, about which
2313 (unsigned int *) &dummy
);
2316 /* Absolute to relative. */
2317 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2318 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2323 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2324 Sx_get_atom_name
, 1, 2, 0,
2325 doc
: /* Return the X atom name for VALUE as a string.
2326 VALUE may be a number or a cons where the car is the upper 16 bits and
2327 the cdr is the lower 16 bits of a 32 bit value.
2328 Use the display for FRAME or the current frame if FRAME is not given or nil.
2330 If the value is 0 or the atom is not known, return the empty string. */)
2331 (Lisp_Object value
, Lisp_Object frame
)
2333 struct frame
*f
= check_x_frame (frame
);
2336 Lisp_Object ret
= Qnil
;
2337 Display
*dpy
= FRAME_X_DISPLAY (f
);
2341 if (INTEGERP (value
))
2342 atom
= (Atom
) XUINT (value
);
2343 else if (FLOATP (value
))
2344 atom
= (Atom
) XFLOAT_DATA (value
);
2345 else if (CONSP (value
))
2346 atom
= (Atom
) cons_to_long (value
);
2348 error ("Wrong type, value must be number or cons");
2351 x_catch_errors (dpy
);
2352 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2353 had_errors
= x_had_errors_p (dpy
);
2354 x_uncatch_errors ();
2357 ret
= make_string (name
, strlen (name
));
2359 if (atom
&& name
) XFree (name
);
2360 if (NILP (ret
)) ret
= empty_unibyte_string
;
2367 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2368 Sx_register_dnd_atom
, 1, 2, 0,
2369 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2370 ATOM can be a symbol or a string. The ATOM is interned on the display that
2371 FRAME is on. If FRAME is nil, the selected frame is used. */)
2372 (Lisp_Object atom
, Lisp_Object frame
)
2375 struct frame
*f
= check_x_frame (frame
);
2377 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2381 x_atom
= symbol_to_x_atom (dpyinfo
, FRAME_X_DISPLAY (f
), atom
);
2382 else if (STRINGP (atom
))
2385 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2389 error ("ATOM must be a symbol or a string");
2391 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2392 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2395 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2397 dpyinfo
->x_dnd_atoms_size
*= 2;
2398 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2399 sizeof (*dpyinfo
->x_dnd_atoms
)
2400 * dpyinfo
->x_dnd_atoms_size
);
2403 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2407 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2410 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2414 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2415 unsigned long size
= 160/event
->format
;
2417 unsigned char *data
= (unsigned char *) event
->data
.b
;
2421 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2422 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2424 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2426 XSETFRAME (frame
, f
);
2428 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2429 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2430 function expects them to be of size int (i.e. 32). So to be able to
2431 use that function, put the data in the form it expects if format is 32. */
2433 if (event
->format
== 32 && event
->format
< BITS_PER_LONG
)
2435 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2436 idata
[i
] = (int) event
->data
.l
[i
];
2437 data
= (unsigned char *) idata
;
2440 vec
= Fmake_vector (make_number (4), Qnil
);
2441 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2442 event
->message_type
)));
2443 ASET (vec
, 1, frame
);
2444 ASET (vec
, 2, make_number (event
->format
));
2445 ASET (vec
, 3, x_property_data_to_lisp (f
,
2447 event
->message_type
,
2451 mouse_position_for_drop (f
, &x
, &y
);
2452 bufp
->kind
= DRAG_N_DROP_EVENT
;
2453 bufp
->frame_or_window
= frame
;
2454 bufp
->timestamp
= CurrentTime
;
2455 bufp
->x
= make_number (x
);
2456 bufp
->y
= make_number (y
);
2458 bufp
->modifiers
= 0;
2463 DEFUN ("x-send-client-message", Fx_send_client_event
,
2464 Sx_send_client_message
, 6, 6, 0,
2465 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2467 For DISPLAY, specify either a frame or a display name (a string).
2468 If DISPLAY is nil, that stands for the selected frame's display.
2469 DEST may be a number, in which case it is a Window id. The value 0 may
2470 be used to send to the root window of the DISPLAY.
2471 If DEST is a cons, it is converted to a 32 bit number
2472 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2473 number is then used as a window id.
2474 If DEST is a frame the event is sent to the outer window of that frame.
2475 A value of nil means the currently selected frame.
2476 If DEST is the string "PointerWindow" the event is sent to the window that
2477 contains the pointer. If DEST is the string "InputFocus" the event is
2478 sent to the window that has the input focus.
2479 FROM is the frame sending the event. Use nil for currently selected frame.
2480 MESSAGE-TYPE is the name of an Atom as a string.
2481 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2482 bits. VALUES is a list of numbers, cons and/or strings containing the values
2483 to send. If a value is a string, it is converted to an Atom and the value of
2484 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2485 with the high 16 bits from the car and the lower 16 bit from the cdr.
2486 If more values than fits into the event is given, the excessive values
2488 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2490 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2492 CHECK_STRING (message_type
);
2493 x_send_client_event(display
, dest
, from
,
2494 XInternAtom (dpyinfo
->display
,
2495 SSDATA (message_type
),
2503 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2505 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2508 struct frame
*f
= check_x_frame (from
);
2511 CHECK_NUMBER (format
);
2512 CHECK_CONS (values
);
2514 if (x_check_property_data (values
) == -1)
2515 error ("Bad data in VALUES, must be number, cons or string");
2517 event
.xclient
.type
= ClientMessage
;
2518 event
.xclient
.format
= XFASTINT (format
);
2520 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2521 && event
.xclient
.format
!= 32)
2522 error ("FORMAT must be one of 8, 16 or 32");
2524 if (FRAMEP (dest
) || NILP (dest
))
2526 struct frame
*fdest
= check_x_frame (dest
);
2527 wdest
= FRAME_OUTER_WINDOW (fdest
);
2529 else if (STRINGP (dest
))
2531 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2532 wdest
= PointerWindow
;
2533 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2536 error ("DEST as a string must be one of PointerWindow or InputFocus");
2538 else if (INTEGERP (dest
))
2539 wdest
= (Window
) XFASTINT (dest
);
2540 else if (FLOATP (dest
))
2541 wdest
= (Window
) XFLOAT_DATA (dest
);
2542 else if (CONSP (dest
))
2544 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2545 error ("Both car and cdr for DEST must be numbers");
2547 wdest
= (Window
) cons_to_long (dest
);
2550 error ("DEST must be a frame, nil, string, number or cons");
2552 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2553 to_root
= wdest
== dpyinfo
->root_window
;
2557 event
.xclient
.message_type
= message_type
;
2558 event
.xclient
.display
= dpyinfo
->display
;
2560 /* Some clients (metacity for example) expects sending window to be here
2561 when sending to the root window. */
2562 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2565 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2566 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2567 event
.xclient
.format
);
2569 /* If event mask is 0 the event is sent to the client that created
2570 the destination window. But if we are sending to the root window,
2571 there is no such client. Then we set the event mask to 0xffff. The
2572 event then goes to clients selecting for events on the root window. */
2573 x_catch_errors (dpyinfo
->display
);
2575 int propagate
= to_root
? False
: True
;
2576 unsigned mask
= to_root
? 0xffff : 0;
2577 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2578 XFlush (dpyinfo
->display
);
2580 x_uncatch_errors ();
2586 syms_of_xselect (void)
2588 defsubr (&Sx_get_selection_internal
);
2589 defsubr (&Sx_own_selection_internal
);
2590 defsubr (&Sx_disown_selection_internal
);
2591 defsubr (&Sx_selection_owner_p
);
2592 defsubr (&Sx_selection_exists_p
);
2594 defsubr (&Sx_get_atom_name
);
2595 defsubr (&Sx_send_client_message
);
2596 defsubr (&Sx_register_dnd_atom
);
2598 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2599 staticpro (&reading_selection_reply
);
2600 reading_selection_window
= 0;
2601 reading_which_selection
= 0;
2603 property_change_wait_list
= 0;
2604 prop_location_identifier
= 0;
2605 property_change_reply
= Fcons (Qnil
, Qnil
);
2606 staticpro (&property_change_reply
);
2608 Vselection_alist
= Qnil
;
2609 staticpro (&Vselection_alist
);
2611 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2612 doc
: /* An alist associating X Windows selection-types with functions.
2613 These functions are called to convert the selection, with three args:
2614 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2615 a desired type to which the selection should be converted;
2616 and the local selection value (whatever was given to `x-own-selection').
2618 The function should return the value to send to the X server
2619 \(typically a string). A return value of nil
2620 means that the conversion could not be done.
2621 A return value which is the symbol `NULL'
2622 means that a side-effect was executed,
2623 and there is no meaningful selection value. */);
2624 Vselection_converter_alist
= Qnil
;
2626 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2627 doc
: /* A list of functions to be called when Emacs loses an X selection.
2628 \(This happens when some other X client makes its own selection
2629 or when a Lisp program explicitly clears the selection.)
2630 The functions are called with one argument, the selection type
2631 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2632 Vx_lost_selection_functions
= Qnil
;
2634 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2635 doc
: /* A list of functions to be called when Emacs answers a selection request.
2636 The functions are called with four arguments:
2637 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2638 - the selection-type which Emacs was asked to convert the
2639 selection into before sending (for example, `STRING' or `LENGTH');
2640 - a flag indicating success or failure for responding to the request.
2641 We might have failed (and declined the request) for any number of reasons,
2642 including being asked for a selection that we no longer own, or being asked
2643 to convert into a type that we don't know about or that is inappropriate.
2644 This hook doesn't let you change the behavior of Emacs's selection replies,
2645 it merely informs you that they have happened. */);
2646 Vx_sent_selection_functions
= Qnil
;
2648 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2649 doc
: /* Number of milliseconds to wait for a selection reply.
2650 If the selection owner doesn't reply in this time, we give up.
2651 A value of 0 means wait as long as necessary. This is initialized from the
2652 \"*selectionTimeout\" resource. */);
2653 x_selection_timeout
= 0;
2655 /* QPRIMARY is defined in keyboard.c. */
2656 QSECONDARY
= intern_c_string ("SECONDARY"); staticpro (&QSECONDARY
);
2657 QSTRING
= intern_c_string ("STRING"); staticpro (&QSTRING
);
2658 QINTEGER
= intern_c_string ("INTEGER"); staticpro (&QINTEGER
);
2659 QCLIPBOARD
= intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2660 QTIMESTAMP
= intern_c_string ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2661 QTEXT
= intern_c_string ("TEXT"); staticpro (&QTEXT
);
2662 QCOMPOUND_TEXT
= intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2663 QUTF8_STRING
= intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2664 QDELETE
= intern_c_string ("DELETE"); staticpro (&QDELETE
);
2665 QMULTIPLE
= intern_c_string ("MULTIPLE"); staticpro (&QMULTIPLE
);
2666 QINCR
= intern_c_string ("INCR"); staticpro (&QINCR
);
2667 QEMACS_TMP
= intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2668 QTARGETS
= intern_c_string ("TARGETS"); staticpro (&QTARGETS
);
2669 QATOM
= intern_c_string ("ATOM"); staticpro (&QATOM
);
2670 QATOM_PAIR
= intern_c_string ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2671 QNULL
= intern_c_string ("NULL"); staticpro (&QNULL
);
2672 Qcompound_text_with_extensions
= intern_c_string ("compound-text-with-extensions");
2673 staticpro (&Qcompound_text_with_extensions
);
2675 Qforeign_selection
= intern_c_string ("foreign-selection");
2676 staticpro (&Qforeign_selection
);