1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994 Free Software Foundation.
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 2, or (at your option)
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; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* x_handle_selection_notify
21 x_reply_selection_request */
24 /* Rewritten by jwz */
29 #include <stdio.h> /* termhooks.h needs this */
30 #include "termhooks.h"
32 #include "xterm.h" /* for all of the X includes */
33 #include "dispextern.h" /* frame.h seems to want this */
34 #include "frame.h" /* Need this to get the X window of selected_frame */
35 #include "blockinput.h"
39 #define CUT_BUFFER_SUPPORT
41 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
42 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
45 #ifdef CUT_BUFFER_SUPPORT
46 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
47 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
50 Lisp_Object Vx_lost_selection_hooks
;
51 Lisp_Object Vx_sent_selection_hooks
;
53 /* If this is a smaller number than the max-request-size of the display,
54 emacs will use INCR selection transfer when the selection is larger
55 than this. The max-request-size is usually around 64k, so if you want
56 emacs to use incremental selection transfers when the selection is
57 smaller than that, set this. I added this mostly for debugging the
58 incremental transfer stuff, but it might improve server performance.
60 #define MAX_SELECTION_QUANTUM 0xFFFFFF
63 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
65 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
68 /* The timestamp of the last input event Emacs received from the X server. */
69 unsigned long last_event_timestamp
;
71 /* This is an association list whose elements are of the form
72 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
73 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
74 SELECTION-VALUE is the value that emacs owns for that selection.
75 It may be any kind of Lisp object.
76 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
77 as a cons of two 16-bit numbers (making a 32 bit time.)
78 FRAME is the frame for which we made the selection.
79 If there is an entry in this alist, then it can be assumed that Emacs owns
81 The only (eq) parts of this list that are visible from Lisp are the
84 Lisp_Object Vselection_alist
;
86 /* This is an alist whose CARs are selection-types (whose names are the same
87 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
88 call to convert the given Emacs selection value to a string representing
89 the given selection type. This is for Lisp-level extension of the emacs
92 Lisp_Object Vselection_converter_alist
;
94 /* If the selection owner takes too long to reply to a selection request,
95 we give up on it. This is in milliseconds (0 = no timeout.)
97 int x_selection_timeout
;
99 /* Utility functions */
101 static void lisp_data_to_selection_data ();
102 static Lisp_Object
selection_data_to_lisp_data ();
103 static Lisp_Object
x_get_window_property_as_lisp_data ();
105 /* This converts a Lisp symbol to a server Atom, avoiding a server
106 roundtrip whenever possible. */
109 symbol_to_x_atom (dpyinfo
, display
, sym
)
110 struct x_display_info
*dpyinfo
;
115 if (NILP (sym
)) return 0;
116 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
117 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
118 if (EQ (sym
, QSTRING
)) return XA_STRING
;
119 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
120 if (EQ (sym
, QATOM
)) return XA_ATOM
;
121 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
122 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
123 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
124 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
125 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
126 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
127 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
128 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
129 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
130 #ifdef CUT_BUFFER_SUPPORT
131 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
132 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
133 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
134 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
135 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
136 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
137 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
138 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
140 if (!SYMBOLP (sym
)) abort ();
143 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
146 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
152 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
153 and calls to intern whenever possible. */
156 x_atom_to_symbol (dpyinfo
, display
, atom
)
157 struct x_display_info
*dpyinfo
;
163 if (! atom
) return Qnil
;
176 #ifdef CUT_BUFFER_SUPPORT
196 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
198 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
200 if (atom
== dpyinfo
->Xatom_TEXT
)
202 if (atom
== dpyinfo
->Xatom_DELETE
)
204 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
206 if (atom
== dpyinfo
->Xatom_INCR
)
208 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
210 if (atom
== dpyinfo
->Xatom_TARGETS
)
212 if (atom
== dpyinfo
->Xatom_NULL
)
216 str
= XGetAtomName (display
, atom
);
219 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
221 if (! str
) return Qnil
;
229 /* Do protocol to assert ourself as a selection owner.
230 Update the Vselection_alist so that we can reply to later requests for
234 x_own_selection (selection_name
, selection_value
)
235 Lisp_Object selection_name
, selection_value
;
237 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
238 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
239 Time time
= last_event_timestamp
;
241 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
243 CHECK_SYMBOL (selection_name
, 0);
244 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
247 x_catch_errors (display
);
248 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
249 x_check_errors (display
, "Can't set selection: %s");
250 x_uncatch_errors (display
);
253 /* Now update the local cache */
255 Lisp_Object selection_time
;
256 Lisp_Object selection_data
;
257 Lisp_Object prev_value
;
259 selection_time
= long_to_cons ((unsigned long) time
);
260 selection_data
= Fcons (selection_name
,
261 Fcons (selection_value
,
262 Fcons (selection_time
,
263 Fcons (Fselected_frame (), Qnil
))));
264 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
266 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
268 /* If we already owned the selection, remove the old selection data.
269 Perhaps we should destructively modify it instead.
270 Don't use Fdelq as that may QUIT. */
271 if (!NILP (prev_value
))
273 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
274 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
275 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
277 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
284 /* Given a selection-name and desired type, look up our local copy of
285 the selection value and convert it to the type.
286 The value is nil or a string.
287 This function is used both for remote requests
288 and for local x-get-selection-internal.
290 This calls random Lisp code, and may signal or gc. */
293 x_get_local_selection (selection_symbol
, target_type
)
294 Lisp_Object selection_symbol
, target_type
;
296 Lisp_Object local_value
;
297 Lisp_Object handler_fn
, value
, type
, check
;
300 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
302 if (NILP (local_value
)) return Qnil
;
304 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
305 if (EQ (target_type
, QTIMESTAMP
))
308 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
311 else if (EQ (target_type
, QDELETE
))
314 Fx_disown_selection_internal
316 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
321 #if 0 /* #### MULTIPLE doesn't work yet */
322 else if (CONSP (target_type
)
323 && XCONS (target_type
)->car
== QMULTIPLE
)
328 pairs
= XCONS (target_type
)->cdr
;
329 size
= XVECTOR (pairs
)->size
;
330 /* If the target is MULTIPLE, then target_type looks like
331 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
332 We modify the second element of each pair in the vector and
333 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
335 for (i
= 0; i
< size
; i
++)
338 pair
= XVECTOR (pairs
)->contents
[i
];
339 XVECTOR (pair
)->contents
[1]
340 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
341 XVECTOR (pair
)->contents
[1]);
348 /* Don't allow a quit within the converter.
349 When the user types C-g, he would be surprised
350 if by luck it came during a converter. */
351 count
= specpdl_ptr
- specpdl
;
352 specbind (Qinhibit_quit
, Qt
);
354 CHECK_SYMBOL (target_type
, 0);
355 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
356 if (!NILP (handler_fn
))
357 value
= call3 (handler_fn
,
358 selection_symbol
, target_type
,
359 XCONS (XCONS (local_value
)->cdr
)->car
);
362 unbind_to (count
, Qnil
);
365 /* Make sure this value is of a type that we could transmit
366 to another X client. */
370 && SYMBOLP (XCONS (value
)->car
))
371 type
= XCONS (value
)->car
,
372 check
= XCONS (value
)->cdr
;
380 /* Check for a value that cons_to_long could handle. */
381 else if (CONSP (check
)
382 && INTEGERP (XCONS (check
)->car
)
383 && (INTEGERP (XCONS (check
)->cdr
)
385 (CONSP (XCONS (check
)->cdr
)
386 && INTEGERP (XCONS (XCONS (check
)->cdr
)->car
)
387 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
392 Fcons (build_string ("invalid data returned by selection-conversion function"),
393 Fcons (handler_fn
, Fcons (value
, Qnil
))));
396 /* Subroutines of x_reply_selection_request. */
398 /* Send a SelectionNotify event to the requestor with property=None,
399 meaning we were unable to do what they wanted. */
402 x_decline_selection_request (event
)
403 struct input_event
*event
;
405 XSelectionEvent reply
;
406 reply
.type
= SelectionNotify
;
407 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
408 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
409 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
410 reply
.time
= SELECTION_EVENT_TIME (event
);
411 reply
.target
= SELECTION_EVENT_TARGET (event
);
412 reply
.property
= None
;
415 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
417 XFlush (reply
.display
);
421 /* This is the selection request currently being processed.
422 It is set to zero when the request is fully processed. */
423 static struct input_event
*x_selection_current_request
;
425 /* Used as an unwind-protect clause so that, if a selection-converter signals
426 an error, we tell the requestor that we were unable to do what they wanted
427 before we throw to top-level or go into the debugger or whatever. */
430 x_selection_request_lisp_error (ignore
)
433 if (x_selection_current_request
!= 0)
434 x_decline_selection_request (x_selection_current_request
);
439 /* This stuff is so that INCR selections are reentrant (that is, so we can
440 be servicing multiple INCR selection requests simultaneously.) I haven't
441 actually tested that yet. */
443 /* Keep a list of the property changes that are awaited. */
453 struct prop_location
*next
;
456 static struct prop_location
*expect_property_change ();
457 static void wait_for_property_change ();
458 static void unexpect_property_change ();
459 static int waiting_for_other_props_on_window ();
461 static int prop_location_identifier
;
463 static Lisp_Object property_change_reply
;
465 static struct prop_location
*property_change_reply_object
;
467 static struct prop_location
*property_change_wait_list
;
469 /* Send the reply to a selection request event EVENT.
470 TYPE is the type of selection data requested.
471 DATA and SIZE describe the data to send, already converted.
472 FORMAT is the unit-size (in bits) of the data to be transmitted. */
475 x_reply_selection_request (event
, format
, data
, size
, type
)
476 struct input_event
*event
;
481 XSelectionEvent reply
;
482 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
483 Window window
= SELECTION_EVENT_REQUESTOR (event
);
485 int format_bytes
= format
/8;
486 int max_bytes
= SELECTION_QUANTUM (display
);
487 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
489 if (max_bytes
> MAX_SELECTION_QUANTUM
)
490 max_bytes
= MAX_SELECTION_QUANTUM
;
492 reply
.type
= SelectionNotify
;
493 reply
.display
= display
;
494 reply
.requestor
= window
;
495 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
496 reply
.time
= SELECTION_EVENT_TIME (event
);
497 reply
.target
= SELECTION_EVENT_TARGET (event
);
498 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
499 if (reply
.property
== None
)
500 reply
.property
= reply
.target
;
502 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
504 /* Store the data on the requested property.
505 If the selection is large, only store the first N bytes of it.
507 bytes_remaining
= size
* format_bytes
;
508 if (bytes_remaining
<= max_bytes
)
510 /* Send all the data at once, with minimal handshaking. */
512 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
515 XChangeProperty (display
, window
, reply
.property
, type
, format
,
516 PropModeReplace
, data
, size
);
517 /* At this point, the selection was successfully stored; ack it. */
518 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
524 /* Send an INCR selection. */
525 struct prop_location
*wait_object
;
529 if (x_window_to_frame (window
)) /* #### debug */
530 error ("attempt to transfer an INCR to ourself!");
532 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
534 wait_object
= expect_property_change (display
, window
, reply
.property
,
537 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
538 32, PropModeReplace
, (unsigned char *)
539 &bytes_remaining
, 1);
540 XSelectInput (display
, window
, PropertyChangeMask
);
541 /* Tell 'em the INCR data is there... */
542 (void) XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
546 /* First, wait for the requestor to ack by deleting the property.
547 This can run random lisp code (process handlers) or signal. */
548 wait_for_property_change (wait_object
);
550 while (bytes_remaining
)
552 int i
= ((bytes_remaining
< max_bytes
)
559 = expect_property_change (display
, window
, reply
.property
,
562 fprintf (stderr
," INCR adding %d\n", i
);
564 /* Append the next chunk of data to the property. */
565 XChangeProperty (display
, window
, reply
.property
, type
, format
,
566 PropModeAppend
, data
, i
/ format_bytes
);
567 bytes_remaining
-= i
;
572 /* Now wait for the requestor to ack this chunk by deleting the
573 property. This can run random lisp code or signal.
575 wait_for_property_change (wait_object
);
577 /* Now write a zero-length chunk to the property to tell the requestor
580 fprintf (stderr
," INCR done\n");
583 if (! waiting_for_other_props_on_window (display
, window
))
584 XSelectInput (display
, window
, 0L);
586 XChangeProperty (display
, window
, reply
.property
, type
, format
,
587 PropModeReplace
, data
, 0);
593 /* Handle a SelectionRequest event EVENT.
594 This is called from keyboard.c when such an event is found in the queue. */
597 x_handle_selection_request (event
)
598 struct input_event
*event
;
600 struct gcpro gcpro1
, gcpro2
, gcpro3
;
601 Lisp_Object local_selection_data
;
602 Lisp_Object selection_symbol
;
603 Lisp_Object target_symbol
;
604 Lisp_Object converted_selection
;
605 Time local_selection_time
;
606 Lisp_Object successful_p
;
608 struct x_display_info
*dpyinfo
609 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
611 local_selection_data
= Qnil
;
612 target_symbol
= Qnil
;
613 converted_selection
= Qnil
;
616 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
618 selection_symbol
= x_atom_to_symbol (dpyinfo
,
619 SELECTION_EVENT_DISPLAY (event
),
620 SELECTION_EVENT_SELECTION (event
));
622 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
624 if (NILP (local_selection_data
))
626 /* Someone asked for the selection, but we don't have it any more.
628 x_decline_selection_request (event
);
632 local_selection_time
= (Time
)
633 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
635 if (SELECTION_EVENT_TIME (event
) != CurrentTime
636 && local_selection_time
> SELECTION_EVENT_TIME (event
))
638 /* Someone asked for the selection, and we have one, but not the one
641 x_decline_selection_request (event
);
645 count
= specpdl_ptr
- specpdl
;
646 x_selection_current_request
= event
;
647 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
649 target_symbol
= x_atom_to_symbol (dpyinfo
, SELECTION_EVENT_DISPLAY (event
),
650 SELECTION_EVENT_TARGET (event
));
652 #if 0 /* #### MULTIPLE doesn't work yet */
653 if (EQ (target_symbol
, QMULTIPLE
))
654 target_symbol
= fetch_multiple_target (event
);
657 /* Convert lisp objects back into binary data */
660 = x_get_local_selection (selection_symbol
, target_symbol
);
662 if (! NILP (converted_selection
))
670 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
672 &data
, &type
, &size
, &format
, &nofree
);
674 x_reply_selection_request (event
, format
, data
, size
, type
);
677 /* Indicate we have successfully processed this event. */
678 x_selection_current_request
= 0;
683 unbind_to (count
, Qnil
);
689 /* Let random lisp code notice that the selection has been asked for. */
692 rest
= Vx_sent_selection_hooks
;
693 if (!EQ (rest
, Qunbound
))
694 for (; CONSP (rest
); rest
= Fcdr (rest
))
695 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
699 /* Handle a SelectionClear event EVENT, which indicates that some other
700 client cleared out our previously asserted selection.
701 This is called from keyboard.c when such an event is found in the queue. */
704 x_handle_selection_clear (event
)
705 struct input_event
*event
;
707 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
708 Atom selection
= SELECTION_EVENT_SELECTION (event
);
709 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
711 Lisp_Object selection_symbol
, local_selection_data
;
712 Time local_selection_time
;
713 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
715 selection_symbol
= x_atom_to_symbol (dpyinfo
, display
, selection
);
717 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
719 /* Well, we already believe that we don't own it, so that's just fine. */
720 if (NILP (local_selection_data
)) return;
722 local_selection_time
= (Time
)
723 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
725 /* This SelectionClear is for a selection that we no longer own, so we can
726 disregard it. (That is, we have reasserted the selection since this
727 request was generated.) */
729 if (changed_owner_time
!= CurrentTime
730 && local_selection_time
> changed_owner_time
)
733 /* Otherwise, we're really honest and truly being told to drop it.
734 Don't use Fdelq as that may QUIT;. */
736 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
737 Vselection_alist
= Fcdr (Vselection_alist
);
741 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
742 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
744 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
749 /* Let random lisp code notice that the selection has been stolen. */
753 rest
= Vx_lost_selection_hooks
;
754 if (!EQ (rest
, Qunbound
))
756 for (; CONSP (rest
); rest
= Fcdr (rest
))
757 call1 (Fcar (rest
), selection_symbol
);
758 prepare_menu_bars ();
759 redisplay_preserve_echo_area ();
764 /* Clear all selections that were made from frame F.
765 We do this when about to delete a frame. */
768 x_clear_frame_selections (f
)
774 XSETFRAME (frame
, f
);
776 /* Otherwise, we're really honest and truly being told to drop it.
777 Don't use Fdelq as that may QUIT;. */
779 while (!NILP (Vselection_alist
)
780 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
782 /* Let random Lisp code notice that the selection has been stolen. */
783 Lisp_Object hooks
, selection_symbol
;
785 hooks
= Vx_lost_selection_hooks
;
786 selection_symbol
= Fcar (Vselection_alist
);
788 if (!EQ (hooks
, Qunbound
))
790 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
791 call1 (Fcar (hooks
), selection_symbol
);
792 redisplay_preserve_echo_area ();
795 Vselection_alist
= Fcdr (Vselection_alist
);
798 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
799 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest
)->cdr
)))))))
801 /* Let random Lisp code notice that the selection has been stolen. */
802 Lisp_Object hooks
, selection_symbol
;
804 hooks
= Vx_lost_selection_hooks
;
805 selection_symbol
= Fcar (XCONS (rest
)->cdr
);
807 if (!EQ (hooks
, Qunbound
))
809 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
810 call1 (Fcar (hooks
), selection_symbol
);
811 redisplay_preserve_echo_area ();
813 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
818 /* Nonzero if any properties for DISPLAY and WINDOW
819 are on the list of what we are waiting for. */
822 waiting_for_other_props_on_window (display
, window
)
826 struct prop_location
*rest
= property_change_wait_list
;
828 if (rest
->display
== display
&& rest
->window
== window
)
835 /* Add an entry to the list of property changes we are waiting for.
836 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
837 The return value is a number that uniquely identifies
838 this awaited property change. */
840 static struct prop_location
*
841 expect_property_change (display
, window
, property
, state
)
844 Lisp_Object property
;
847 struct prop_location
*pl
848 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
849 pl
->identifier
= ++prop_location_identifier
;
850 pl
->display
= display
;
852 pl
->property
= property
;
853 pl
->desired_state
= state
;
854 pl
->next
= property_change_wait_list
;
856 property_change_wait_list
= pl
;
860 /* Delete an entry from the list of property changes we are waiting for.
861 IDENTIFIER is the number that uniquely identifies the entry. */
864 unexpect_property_change (location
)
865 struct prop_location
*location
;
867 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
870 if (rest
== location
)
873 prev
->next
= rest
->next
;
875 property_change_wait_list
= rest
->next
;
884 /* Remove the property change expectation element for IDENTIFIER. */
887 wait_for_property_change_unwind (identifierval
)
888 Lisp_Object identifierval
;
890 unexpect_property_change ((struct prop_location
*)
891 (XFASTINT (XCONS (identifierval
)->car
) << 16
892 | XFASTINT (XCONS (identifierval
)->cdr
)));
895 /* Actually wait for a property change.
896 IDENTIFIER should be the value that expect_property_change returned. */
899 wait_for_property_change (location
)
900 struct prop_location
*location
;
903 int count
= specpdl_ptr
- specpdl
;
906 tem
= Fcons (Qnil
, Qnil
);
907 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
908 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
910 /* Make sure to do unexpect_property_change if we quit or err. */
911 record_unwind_protect (wait_for_property_change_unwind
, tem
);
913 XCONS (property_change_reply
)->car
= Qnil
;
915 if (! location
->arrived
)
917 property_change_reply_object
= location
;
918 secs
= x_selection_timeout
/ 1000;
919 usecs
= (x_selection_timeout
% 1000) * 1000;
920 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
922 if (NILP (XCONS (property_change_reply
)->car
))
923 error ("timed out waiting for property-notify event");
926 unbind_to (count
, Qnil
);
929 /* Called from XTread_socket in response to a PropertyNotify event. */
932 x_handle_property_notify (event
)
933 XPropertyEvent
*event
;
935 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
938 if (rest
->property
== event
->atom
939 && rest
->window
== event
->window
940 && rest
->display
== event
->display
941 && rest
->desired_state
== event
->state
)
944 fprintf (stderr
, "Saw expected prop-%s on %s\n",
945 (event
->state
== PropertyDelete
? "delete" : "change"),
946 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
953 /* If this is the one wait_for_property_change is waiting for,
954 tell it to wake up. */
955 if (rest
== property_change_reply_object
)
956 XCONS (property_change_reply
)->car
= Qt
;
959 prev
->next
= rest
->next
;
961 property_change_wait_list
= rest
->next
;
969 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
970 (event
->state
== PropertyDelete
? "delete" : "change"),
971 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
972 event
->display
, event
->atom
))
979 #if 0 /* #### MULTIPLE doesn't work yet */
982 fetch_multiple_target (event
)
983 XSelectionRequestEvent
*event
;
985 Display
*display
= event
->display
;
986 Window window
= event
->requestor
;
987 Atom target
= event
->target
;
988 Atom selection_atom
= event
->selection
;
993 x_get_window_property_as_lisp_data (display
, window
, target
,
994 QMULTIPLE
, selection_atom
));
998 copy_multiple_data (obj
)
1005 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1007 CHECK_VECTOR (obj
, 0);
1008 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1009 for (i
= 0; i
< size
; i
++)
1011 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1012 CHECK_VECTOR (vec2
, 0);
1013 if (XVECTOR (vec2
)->size
!= 2)
1014 /* ??? Confusing error message */
1015 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1016 Fcons (vec2
, Qnil
)));
1017 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1018 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1019 = XVECTOR (vec2
)->contents
[0];
1020 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1021 = XVECTOR (vec2
)->contents
[1];
1029 /* Variables for communication with x_handle_selection_notify. */
1030 static Atom reading_which_selection
;
1031 static Lisp_Object reading_selection_reply
;
1032 static Window reading_selection_window
;
1034 /* Do protocol to read selection-data from the server.
1035 Converts this to Lisp data and returns it. */
1038 x_get_foreign_selection (selection_symbol
, target_type
)
1039 Lisp_Object selection_symbol
, target_type
;
1041 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1042 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1043 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1044 Time requestor_time
= last_event_timestamp
;
1045 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1046 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1050 if (CONSP (target_type
))
1051 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1053 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1056 x_catch_errors (display
);
1057 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1058 requestor_window
, requestor_time
);
1061 /* Prepare to block until the reply has been read. */
1062 reading_selection_window
= requestor_window
;
1063 reading_which_selection
= selection_atom
;
1064 XCONS (reading_selection_reply
)->car
= Qnil
;
1065 x_start_queuing_selection_requests (selected_frame
);
1068 /* This allows quits. Also, don't wait forever. */
1069 secs
= x_selection_timeout
/ 1000;
1070 usecs
= (x_selection_timeout
% 1000) * 1000;
1071 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1074 x_check_errors (display
, "Cannot get selection: %s");
1075 x_uncatch_errors (display
);
1076 x_stop_queuing_selection_requests (selected_frame
);
1079 if (NILP (XCONS (reading_selection_reply
)->car
))
1080 error ("timed out waiting for reply from selection owner");
1082 /* Otherwise, the selection is waiting for us on the requested property. */
1084 x_get_window_property_as_lisp_data (display
, requestor_window
,
1085 target_property
, target_type
,
1089 /* Subroutines of x_get_window_property_as_lisp_data */
1092 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1093 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1098 unsigned char **data_ret
;
1100 Atom
*actual_type_ret
;
1101 int *actual_format_ret
;
1102 unsigned long *actual_size_ret
;
1106 unsigned long bytes_remaining
;
1108 unsigned char *tmp_data
= 0;
1110 int buffer_size
= SELECTION_QUANTUM (display
);
1111 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1114 /* First probe the thing to find out how big it is. */
1115 result
= XGetWindowProperty (display
, window
, property
,
1116 0, 0, False
, AnyPropertyType
,
1117 actual_type_ret
, actual_format_ret
,
1119 &bytes_remaining
, &tmp_data
);
1120 if (result
!= Success
)
1127 xfree ((char *) tmp_data
);
1129 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1135 total_size
= bytes_remaining
+ 1;
1136 *data_ret
= (unsigned char *) xmalloc (total_size
);
1138 /* Now read, until weve gotten it all. */
1139 while (bytes_remaining
)
1142 int last
= bytes_remaining
;
1145 = XGetWindowProperty (display
, window
, property
,
1146 offset
/4, buffer_size
/4,
1149 actual_type_ret
, actual_format_ret
,
1150 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1152 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1154 /* If this doesn't return Success at this point, it means that
1155 some clod deleted the selection while we were in the midst of
1156 reading it. Deal with that, I guess....
1158 if (result
!= Success
) break;
1159 *actual_size_ret
*= *actual_format_ret
/ 8;
1160 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1161 offset
+= *actual_size_ret
;
1162 xfree ((char *) tmp_data
);
1167 *bytes_ret
= offset
;
1171 receive_incremental_selection (display
, window
, property
, target_type
,
1172 min_size_bytes
, data_ret
, size_bytes_ret
,
1173 type_ret
, format_ret
, size_ret
)
1177 Lisp_Object target_type
; /* for error messages only */
1178 unsigned int min_size_bytes
;
1179 unsigned char **data_ret
;
1180 int *size_bytes_ret
;
1182 unsigned long *size_ret
;
1186 struct prop_location
*wait_object
;
1187 *size_bytes_ret
= min_size_bytes
;
1188 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1190 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1193 /* At this point, we have read an INCR property.
1194 Delete the property to ack it.
1195 (But first, prepare to receive the next event in this handshake.)
1197 Now, we must loop, waiting for the sending window to put a value on
1198 that property, then reading the property, then deleting it to ack.
1199 We are done when the sender places a property of length 0.
1202 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1203 XDeleteProperty (display
, window
, property
);
1204 wait_object
= expect_property_change (display
, window
, property
,
1211 unsigned char *tmp_data
;
1213 wait_for_property_change (wait_object
);
1214 /* expect it again immediately, because x_get_window_property may
1215 .. no it wont, I dont get it.
1216 .. Ok, I get it now, the Xt code that implements INCR is broken.
1218 x_get_window_property (display
, window
, property
,
1219 &tmp_data
, &tmp_size_bytes
,
1220 type_ret
, format_ret
, size_ret
, 1);
1222 if (tmp_size_bytes
== 0) /* we're done */
1225 fprintf (stderr
, " read INCR done\n");
1227 if (! waiting_for_other_props_on_window (display
, window
))
1228 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1229 unexpect_property_change (wait_object
);
1230 if (tmp_data
) xfree (tmp_data
);
1235 XDeleteProperty (display
, window
, property
);
1236 wait_object
= expect_property_change (display
, window
, property
,
1242 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1244 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1247 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1248 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1250 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1251 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1253 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1254 offset
+= tmp_size_bytes
;
1259 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1260 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1261 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1264 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1269 Lisp_Object target_type
; /* for error messages only */
1270 Atom selection_atom
; /* for error messages only */
1274 unsigned long actual_size
;
1275 unsigned char *data
= 0;
1278 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1280 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1281 &actual_type
, &actual_format
, &actual_size
, 1);
1284 int there_is_a_selection_owner
;
1286 there_is_a_selection_owner
1287 = XGetSelectionOwner (display
, selection_atom
);
1289 while (1) /* Note debugger can no longer return, so this is obsolete */
1291 there_is_a_selection_owner
?
1292 Fcons (build_string ("selection owner couldn't convert"),
1294 ? Fcons (target_type
,
1295 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1298 : Fcons (target_type
, Qnil
))
1299 : Fcons (build_string ("no selection"),
1300 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1305 if (actual_type
== dpyinfo
->Xatom_INCR
)
1307 /* That wasn't really the data, just the beginning. */
1309 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1311 XFree ((char *) data
);
1313 receive_incremental_selection (display
, window
, property
, target_type
,
1314 min_size_bytes
, &data
, &bytes
,
1315 &actual_type
, &actual_format
,
1320 XDeleteProperty (display
, window
, property
);
1324 /* It's been read. Now convert it to a lisp object in some semi-rational
1326 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1327 actual_type
, actual_format
);
1329 xfree ((char *) data
);
1333 /* These functions convert from the selection data read from the server into
1334 something that we can use from Lisp, and vice versa.
1336 Type: Format: Size: Lisp Type:
1337 ----- ------- ----- -----------
1340 ATOM 32 > 1 Vector of Symbols
1342 * 16 > 1 Vector of Integers
1343 * 32 1 if <=16 bits: Integer
1344 if > 16 bits: Cons of top16, bot16
1345 * 32 > 1 Vector of the above
1347 When converting a Lisp number to C, it is assumed to be of format 16 if
1348 it is an integer, and of format 32 if it is a cons of two integers.
1350 When converting a vector of numbers from Lisp to C, it is assumed to be
1351 of format 16 if every element in the vector is an integer, and is assumed
1352 to be of format 32 if any element is a cons of two integers.
1354 When converting an object to C, it may be of the form (SYMBOL . <data>)
1355 where SYMBOL is what we should claim that the type is. Format and
1356 representation are as above. */
1361 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1363 unsigned char *data
;
1367 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1369 if (type
== dpyinfo
->Xatom_NULL
)
1372 /* Convert any 8-bit data to a string, for compactness. */
1373 else if (format
== 8)
1374 return make_string ((char *) data
, size
);
1376 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1377 a vector of symbols.
1379 else if (type
== XA_ATOM
)
1382 if (size
== sizeof (Atom
))
1383 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1386 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1387 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1388 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1389 ((Atom
*) data
) [i
]));
1394 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1395 If the number is > 16 bits, convert it to a cons of integers,
1396 16 bits in each half.
1398 else if (format
== 32 && size
== sizeof (long))
1399 return long_to_cons (((unsigned long *) data
) [0]);
1400 else if (format
== 16 && size
== sizeof (short))
1401 return make_number ((int) (((unsigned short *) data
) [0]));
1403 /* Convert any other kind of data to a vector of numbers, represented
1404 as above (as an integer, or a cons of two 16 bit integers.)
1406 else if (format
== 16)
1409 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1410 for (i
= 0; i
< size
/ 4; i
++)
1412 int j
= (int) ((unsigned short *) data
) [i
];
1413 Faset (v
, i
, make_number (j
));
1420 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1421 for (i
= 0; i
< size
/ 4; i
++)
1423 unsigned long j
= ((unsigned long *) data
) [i
];
1424 Faset (v
, i
, long_to_cons (j
));
1432 lisp_data_to_selection_data (display
, obj
,
1433 data_ret
, type_ret
, size_ret
,
1434 format_ret
, nofree_ret
)
1437 unsigned char **data_ret
;
1439 unsigned int *size_ret
;
1443 Lisp_Object type
= Qnil
;
1444 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1448 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1450 type
= XCONS (obj
)->car
;
1451 obj
= XCONS (obj
)->cdr
;
1452 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1453 obj
= XCONS (obj
)->car
;
1456 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1457 { /* This is not the same as declining */
1463 else if (STRINGP (obj
))
1466 *size_ret
= XSTRING (obj
)->size
;
1467 *data_ret
= XSTRING (obj
)->data
;
1469 if (NILP (type
)) type
= QSTRING
;
1471 else if (SYMBOLP (obj
))
1475 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1476 (*data_ret
) [sizeof (Atom
)] = 0;
1477 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1478 if (NILP (type
)) type
= QATOM
;
1480 else if (INTEGERP (obj
)
1481 && XINT (obj
) < 0xFFFF
1482 && XINT (obj
) > -0xFFFF)
1486 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1487 (*data_ret
) [sizeof (short)] = 0;
1488 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1489 if (NILP (type
)) type
= QINTEGER
;
1491 else if (INTEGERP (obj
)
1492 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1493 && (INTEGERP (XCONS (obj
)->cdr
)
1494 || (CONSP (XCONS (obj
)->cdr
)
1495 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1499 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1500 (*data_ret
) [sizeof (long)] = 0;
1501 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1502 if (NILP (type
)) type
= QINTEGER
;
1504 else if (VECTORP (obj
))
1506 /* Lisp_Vectors may represent a set of ATOMs;
1507 a set of 16 or 32 bit INTEGERs;
1508 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1512 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1513 /* This vector is an ATOM set */
1515 if (NILP (type
)) type
= QATOM
;
1516 *size_ret
= XVECTOR (obj
)->size
;
1518 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1519 for (i
= 0; i
< *size_ret
; i
++)
1520 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1521 (*(Atom
**) data_ret
) [i
]
1522 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1524 Fsignal (Qerror
, /* Qselection_error */
1526 ("all elements of selection vector must have same type"),
1527 Fcons (obj
, Qnil
)));
1529 #if 0 /* #### MULTIPLE doesn't work yet */
1530 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1531 /* This vector is an ATOM_PAIR set */
1533 if (NILP (type
)) type
= QATOM_PAIR
;
1534 *size_ret
= XVECTOR (obj
)->size
;
1536 *data_ret
= (unsigned char *)
1537 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1538 for (i
= 0; i
< *size_ret
; i
++)
1539 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1541 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1542 if (XVECTOR (pair
)->size
!= 2)
1545 ("elements of the vector must be vectors of exactly two elements"),
1546 Fcons (pair
, Qnil
)));
1548 (*(Atom
**) data_ret
) [i
* 2]
1549 = symbol_to_x_atom (dpyinfo
, display
,
1550 XVECTOR (pair
)->contents
[0]);
1551 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1552 = symbol_to_x_atom (dpyinfo
, display
,
1553 XVECTOR (pair
)->contents
[1]);
1558 ("all elements of the vector must be of the same type"),
1559 Fcons (obj
, Qnil
)));
1564 /* This vector is an INTEGER set, or something like it */
1566 *size_ret
= XVECTOR (obj
)->size
;
1567 if (NILP (type
)) type
= QINTEGER
;
1569 for (i
= 0; i
< *size_ret
; i
++)
1570 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1572 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1573 Fsignal (Qerror
, /* Qselection_error */
1575 ("elements of selection vector must be integers or conses of integers"),
1576 Fcons (obj
, Qnil
)));
1578 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1579 for (i
= 0; i
< *size_ret
; i
++)
1580 if (*format_ret
== 32)
1581 (*((unsigned long **) data_ret
)) [i
]
1582 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1584 (*((unsigned short **) data_ret
)) [i
]
1585 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1589 Fsignal (Qerror
, /* Qselection_error */
1590 Fcons (build_string ("unrecognised selection data"),
1591 Fcons (obj
, Qnil
)));
1593 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1597 clean_local_selection_data (obj
)
1601 && INTEGERP (XCONS (obj
)->car
)
1602 && CONSP (XCONS (obj
)->cdr
)
1603 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1604 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1605 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1608 && INTEGERP (XCONS (obj
)->car
)
1609 && INTEGERP (XCONS (obj
)->cdr
))
1611 if (XINT (XCONS (obj
)->car
) == 0)
1612 return XCONS (obj
)->cdr
;
1613 if (XINT (XCONS (obj
)->car
) == -1)
1614 return make_number (- XINT (XCONS (obj
)->cdr
));
1619 int size
= XVECTOR (obj
)->size
;
1622 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1623 copy
= Fmake_vector (size
, Qnil
);
1624 for (i
= 0; i
< size
; i
++)
1625 XVECTOR (copy
)->contents
[i
]
1626 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1632 /* Called from XTread_socket to handle SelectionNotify events.
1633 If it's the selection we are waiting for, stop waiting. */
1636 x_handle_selection_notify (event
)
1637 XSelectionEvent
*event
;
1639 if (event
->requestor
!= reading_selection_window
)
1641 if (event
->selection
!= reading_which_selection
)
1644 XCONS (reading_selection_reply
)->car
= Qt
;
1648 DEFUN ("x-own-selection-internal",
1649 Fx_own_selection_internal
, Sx_own_selection_internal
,
1651 "Assert an X selection of the given TYPE with the given VALUE.\n\
1652 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1653 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1654 VALUE is typically a string, or a cons of two markers, but may be\n\
1655 anything that the functions on `selection-converter-alist' know about.")
1656 (selection_name
, selection_value
)
1657 Lisp_Object selection_name
, selection_value
;
1660 CHECK_SYMBOL (selection_name
, 0);
1661 if (NILP (selection_value
)) error ("selection-value may not be nil.");
1662 x_own_selection (selection_name
, selection_value
);
1663 return selection_value
;
1667 /* Request the selection value from the owner. If we are the owner,
1668 simply return our selection value. If we are not the owner, this
1669 will block until all of the data has arrived. */
1671 DEFUN ("x-get-selection-internal",
1672 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1673 "Return text selected from some X window.\n\
1674 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1675 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1676 TYPE is the type of data desired, typically `STRING'.")
1677 (selection_symbol
, target_type
)
1678 Lisp_Object selection_symbol
, target_type
;
1680 Lisp_Object val
= Qnil
;
1681 struct gcpro gcpro1
, gcpro2
;
1682 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1684 CHECK_SYMBOL (selection_symbol
, 0);
1686 #if 0 /* #### MULTIPLE doesn't work yet */
1687 if (CONSP (target_type
)
1688 && XCONS (target_type
)->car
== QMULTIPLE
)
1690 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1691 /* So we don't destructively modify this... */
1692 target_type
= copy_multiple_data (target_type
);
1696 CHECK_SYMBOL (target_type
, 0);
1698 val
= x_get_local_selection (selection_symbol
, target_type
);
1702 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1707 && SYMBOLP (XCONS (val
)->car
))
1709 val
= XCONS (val
)->cdr
;
1710 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1711 val
= XCONS (val
)->car
;
1713 val
= clean_local_selection_data (val
);
1719 DEFUN ("x-disown-selection-internal",
1720 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1721 "If we own the selection SELECTION, disown it.\n\
1722 Disowning it means there is no such selection.")
1724 Lisp_Object selection
;
1728 Atom selection_atom
;
1729 XSelectionClearEvent event
;
1731 struct x_display_info
*dpyinfo
;
1734 display
= FRAME_X_DISPLAY (selected_frame
);
1735 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1736 CHECK_SYMBOL (selection
, 0);
1738 timestamp
= last_event_timestamp
;
1740 timestamp
= cons_to_long (time
);
1742 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1743 return Qnil
; /* Don't disown the selection when we're not the owner. */
1745 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1748 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1751 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1752 generated for a window which owns the selection when that window sets
1753 the selection owner to None. The NCD server does, the MIT Sun4 server
1754 doesn't. So we synthesize one; this means we might get two, but
1755 that's ok, because the second one won't have any effect. */
1756 SELECTION_EVENT_DISPLAY (&event
) = display
;
1757 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1758 SELECTION_EVENT_TIME (&event
) = timestamp
;
1759 x_handle_selection_clear (&event
);
1764 /* Get rid of all the selections in buffer BUFFER.
1765 This is used when we kill a buffer. */
1768 x_disown_buffer_selections (buffer
)
1772 struct buffer
*buf
= XBUFFER (buffer
);
1774 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1776 Lisp_Object elt
, value
;
1777 elt
= XCONS (tail
)->car
;
1778 value
= XCONS (elt
)->cdr
;
1779 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1780 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1781 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1785 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1787 "Whether the current Emacs process owns the given X Selection.\n\
1788 The arg should be the name of the selection in question, typically one of\n\
1789 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1790 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1791 For convenience, the symbol nil is the same as `PRIMARY',\n\
1792 and t is the same as `SECONDARY'.)")
1794 Lisp_Object selection
;
1797 CHECK_SYMBOL (selection
, 0);
1798 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1799 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1801 if (NILP (Fassq (selection
, Vselection_alist
)))
1806 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1808 "Whether there is an owner for the given X Selection.\n\
1809 The arg should be the name of the selection in question, typically one of\n\
1810 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1811 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1812 For convenience, the symbol nil is the same as `PRIMARY',\n\
1813 and t is the same as `SECONDARY'.)")
1815 Lisp_Object selection
;
1821 /* It should be safe to call this before we have an X frame. */
1822 if (! FRAME_X_P (selected_frame
))
1825 dpy
= FRAME_X_DISPLAY (selected_frame
);
1826 CHECK_SYMBOL (selection
, 0);
1827 if (!NILP (Fx_selection_owner_p (selection
)))
1829 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1830 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1831 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1836 owner
= XGetSelectionOwner (dpy
, atom
);
1838 return (owner
? Qt
: Qnil
);
1842 #ifdef CUT_BUFFER_SUPPORT
1844 static int cut_buffers_initialized
; /* Whether we're sure they all exist */
1846 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1848 initialize_cut_buffers (display
, window
)
1852 unsigned char *data
= (unsigned char *) "";
1854 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1855 PropModeAppend, data, 0)
1856 FROB (XA_CUT_BUFFER0
);
1857 FROB (XA_CUT_BUFFER1
);
1858 FROB (XA_CUT_BUFFER2
);
1859 FROB (XA_CUT_BUFFER3
);
1860 FROB (XA_CUT_BUFFER4
);
1861 FROB (XA_CUT_BUFFER5
);
1862 FROB (XA_CUT_BUFFER6
);
1863 FROB (XA_CUT_BUFFER7
);
1866 cut_buffers_initialized
= 1;
1870 #define CHECK_CUT_BUFFER(symbol,n) \
1871 { CHECK_SYMBOL ((symbol), (n)); \
1872 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1873 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1874 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1875 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1877 Fcons (build_string ("doesn't name a cut buffer"), \
1878 Fcons ((symbol), Qnil))); \
1881 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1882 Sx_get_cut_buffer_internal
, 1, 1, 0,
1883 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1889 unsigned char *data
;
1896 struct x_display_info
*dpyinfo
;
1899 display
= FRAME_X_DISPLAY (selected_frame
);
1900 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1901 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1902 CHECK_CUT_BUFFER (buffer
, 0);
1903 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1905 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1906 &type
, &format
, &size
, 0);
1907 if (!data
) return Qnil
;
1909 if (format
!= 8 || type
!= XA_STRING
)
1911 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1912 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
1913 Fcons (make_number (format
), Qnil
))));
1915 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1921 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
1922 Sx_store_cut_buffer_internal
, 2, 2, 0,
1923 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1925 Lisp_Object buffer
, string
;
1929 unsigned char *data
;
1931 int bytes_remaining
;
1936 display
= FRAME_X_DISPLAY (selected_frame
);
1937 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1939 max_bytes
= SELECTION_QUANTUM (display
);
1940 if (max_bytes
> MAX_SELECTION_QUANTUM
)
1941 max_bytes
= MAX_SELECTION_QUANTUM
;
1943 CHECK_CUT_BUFFER (buffer
, 0);
1944 CHECK_STRING (string
, 0);
1945 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1947 data
= (unsigned char *) XSTRING (string
)->data
;
1948 bytes
= XSTRING (string
)->size
;
1949 bytes_remaining
= bytes
;
1951 if (! cut_buffers_initialized
) initialize_cut_buffers (display
, window
);
1955 /* Don't mess up with an empty value. */
1956 if (!bytes_remaining
)
1957 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1958 PropModeReplace
, data
, 0);
1960 while (bytes_remaining
)
1962 int chunk
= (bytes_remaining
< max_bytes
1963 ? bytes_remaining
: max_bytes
);
1964 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1965 (bytes_remaining
== bytes
1970 bytes_remaining
-= chunk
;
1977 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
1978 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
1979 "Rotate the values of the cut buffers by the given number of steps;\n\
1980 positive means move values forward, negative means backward.")
1989 display
= FRAME_X_DISPLAY (selected_frame
);
1990 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1991 CHECK_NUMBER (n
, 0);
1994 if (! cut_buffers_initialized
)
1995 initialize_cut_buffers (display
, window
);
1997 props
[0] = XA_CUT_BUFFER0
;
1998 props
[1] = XA_CUT_BUFFER1
;
1999 props
[2] = XA_CUT_BUFFER2
;
2000 props
[3] = XA_CUT_BUFFER3
;
2001 props
[4] = XA_CUT_BUFFER4
;
2002 props
[5] = XA_CUT_BUFFER5
;
2003 props
[6] = XA_CUT_BUFFER6
;
2004 props
[7] = XA_CUT_BUFFER7
;
2006 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2016 defsubr (&Sx_get_selection_internal
);
2017 defsubr (&Sx_own_selection_internal
);
2018 defsubr (&Sx_disown_selection_internal
);
2019 defsubr (&Sx_selection_owner_p
);
2020 defsubr (&Sx_selection_exists_p
);
2022 #ifdef CUT_BUFFER_SUPPORT
2023 defsubr (&Sx_get_cut_buffer_internal
);
2024 defsubr (&Sx_store_cut_buffer_internal
);
2025 defsubr (&Sx_rotate_cut_buffers_internal
);
2026 cut_buffers_initialized
= 0;
2029 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2030 staticpro (&reading_selection_reply
);
2031 reading_selection_window
= 0;
2032 reading_which_selection
= 0;
2034 property_change_wait_list
= 0;
2035 prop_location_identifier
= 0;
2036 property_change_reply
= Fcons (Qnil
, Qnil
);
2037 staticpro (&property_change_reply
);
2039 Vselection_alist
= Qnil
;
2040 staticpro (&Vselection_alist
);
2042 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2043 "An alist associating X Windows selection-types with functions.\n\
2044 These functions are called to convert the selection, with three args:\n\
2045 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2046 a desired type to which the selection should be converted;\n\
2047 and the local selection value (whatever was given to `x-own-selection').\n\
2049 The function should return the value to send to the X server\n\
2050 \(typically a string). A return value of nil\n\
2051 means that the conversion could not be done.\n\
2052 A return value which is the symbol `NULL'\n\
2053 means that a side-effect was executed,\n\
2054 and there is no meaningful selection value.");
2055 Vselection_converter_alist
= Qnil
;
2057 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2058 "A list of functions to be called when Emacs loses an X selection.\n\
2059 \(This happens when some other X client makes its own selection\n\
2060 or when a Lisp program explicitly clears the selection.)\n\
2061 The functions are called with one argument, the selection type\n\
2062 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
2063 Vx_lost_selection_hooks
= Qnil
;
2065 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2066 "A list of functions to be called when Emacs answers a selection request.\n\
2067 The functions are called with four arguments:\n\
2068 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2069 - the selection-type which Emacs was asked to convert the\n\
2070 selection into before sending (for example, `STRING' or `LENGTH');\n\
2071 - a flag indicating success or failure for responding to the request.\n\
2072 We might have failed (and declined the request) for any number of reasons,\n\
2073 including being asked for a selection that we no longer own, or being asked\n\
2074 to convert into a type that we don't know about or that is inappropriate.\n\
2075 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2076 it merely informs you that they have happened.");
2077 Vx_sent_selection_hooks
= Qnil
;
2079 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2080 "Number of milliseconds to wait for a selection reply.\n\
2081 If the selection owner doens't reply in this time, we give up.\n\
2082 A value of 0 means wait as long as necessary. This is initialized from the\n\
2083 \"*selectionTimeout\" resource.");
2084 x_selection_timeout
= 0;
2086 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2087 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2088 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2089 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2090 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2091 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2092 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2093 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2094 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2095 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2096 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2097 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2098 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2099 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2100 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2101 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2103 #ifdef CUT_BUFFER_SUPPORT
2104 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2105 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2106 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2107 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2108 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2109 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2110 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2111 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);