1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995 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. */
21 /* Rewritten by jwz */
25 #include "xterm.h" /* for all of the X includes */
26 #include "dispextern.h" /* frame.h seems to want this */
27 #include "frame.h" /* Need this to get the X window of selected_frame */
28 #include "blockinput.h"
32 #define CUT_BUFFER_SUPPORT
34 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
35 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
38 #ifdef CUT_BUFFER_SUPPORT
39 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
40 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
43 Lisp_Object Vx_lost_selection_hooks
;
44 Lisp_Object Vx_sent_selection_hooks
;
46 /* If this is a smaller number than the max-request-size of the display,
47 emacs will use INCR selection transfer when the selection is larger
48 than this. The max-request-size is usually around 64k, so if you want
49 emacs to use incremental selection transfers when the selection is
50 smaller than that, set this. I added this mostly for debugging the
51 incremental transfer stuff, but it might improve server performance.
53 #define MAX_SELECTION_QUANTUM 0xFFFFFF
56 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
58 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
61 /* The timestamp of the last input event Emacs received from the X server. */
62 unsigned long last_event_timestamp
;
64 /* This is an association list whose elements are of the form
65 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
66 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
67 SELECTION-VALUE is the value that emacs owns for that selection.
68 It may be any kind of Lisp object.
69 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
70 as a cons of two 16-bit numbers (making a 32 bit time.)
71 FRAME is the frame for which we made the selection.
72 If there is an entry in this alist, then it can be assumed that Emacs owns
74 The only (eq) parts of this list that are visible from Lisp are the
77 Lisp_Object Vselection_alist
;
79 /* This is an alist whose CARs are selection-types (whose names are the same
80 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
81 call to convert the given Emacs selection value to a string representing
82 the given selection type. This is for Lisp-level extension of the emacs
85 Lisp_Object Vselection_converter_alist
;
87 /* If the selection owner takes too long to reply to a selection request,
88 we give up on it. This is in milliseconds (0 = no timeout.)
90 int x_selection_timeout
;
92 /* Utility functions */
94 static void lisp_data_to_selection_data ();
95 static Lisp_Object
selection_data_to_lisp_data ();
96 static Lisp_Object
x_get_window_property_as_lisp_data ();
98 /* This converts a Lisp symbol to a server Atom, avoiding a server
99 roundtrip whenever possible. */
102 symbol_to_x_atom (dpyinfo
, display
, sym
)
103 struct x_display_info
*dpyinfo
;
108 if (NILP (sym
)) return 0;
109 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
110 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
111 if (EQ (sym
, QSTRING
)) return XA_STRING
;
112 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
113 if (EQ (sym
, QATOM
)) return XA_ATOM
;
114 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
115 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
116 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
117 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
118 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
119 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
120 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
121 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
122 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
123 #ifdef CUT_BUFFER_SUPPORT
124 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
125 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
126 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
127 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
128 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
129 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
130 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
131 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
133 if (!SYMBOLP (sym
)) abort ();
136 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
139 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
145 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
146 and calls to intern whenever possible. */
149 x_atom_to_symbol (dpyinfo
, display
, atom
)
150 struct x_display_info
*dpyinfo
;
156 if (! atom
) return Qnil
;
169 #ifdef CUT_BUFFER_SUPPORT
189 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
191 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
193 if (atom
== dpyinfo
->Xatom_TEXT
)
195 if (atom
== dpyinfo
->Xatom_DELETE
)
197 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
199 if (atom
== dpyinfo
->Xatom_INCR
)
201 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
203 if (atom
== dpyinfo
->Xatom_TARGETS
)
205 if (atom
== dpyinfo
->Xatom_NULL
)
209 str
= XGetAtomName (display
, atom
);
212 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
214 if (! str
) return Qnil
;
222 /* Do protocol to assert ourself as a selection owner.
223 Update the Vselection_alist so that we can reply to later requests for
227 x_own_selection (selection_name
, selection_value
)
228 Lisp_Object selection_name
, selection_value
;
230 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
231 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
232 Time time
= last_event_timestamp
;
234 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
236 CHECK_SYMBOL (selection_name
, 0);
237 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
240 x_catch_errors (display
);
241 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
242 x_check_errors (display
, "Can't set selection: %s");
243 x_uncatch_errors (display
);
246 /* Now update the local cache */
248 Lisp_Object selection_time
;
249 Lisp_Object selection_data
;
250 Lisp_Object prev_value
;
252 selection_time
= long_to_cons ((unsigned long) time
);
253 selection_data
= Fcons (selection_name
,
254 Fcons (selection_value
,
255 Fcons (selection_time
,
256 Fcons (Fselected_frame (), Qnil
))));
257 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
259 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
261 /* If we already owned the selection, remove the old selection data.
262 Perhaps we should destructively modify it instead.
263 Don't use Fdelq as that may QUIT. */
264 if (!NILP (prev_value
))
266 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
267 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
268 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
270 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
277 /* Given a selection-name and desired type, look up our local copy of
278 the selection value and convert it to the type.
279 The value is nil or a string.
280 This function is used both for remote requests
281 and for local x-get-selection-internal.
283 This calls random Lisp code, and may signal or gc. */
286 x_get_local_selection (selection_symbol
, target_type
)
287 Lisp_Object selection_symbol
, target_type
;
289 Lisp_Object local_value
;
290 Lisp_Object handler_fn
, value
, type
, check
;
293 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
295 if (NILP (local_value
)) return Qnil
;
297 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
298 if (EQ (target_type
, QTIMESTAMP
))
301 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
304 else if (EQ (target_type
, QDELETE
))
307 Fx_disown_selection_internal
309 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
314 #if 0 /* #### MULTIPLE doesn't work yet */
315 else if (CONSP (target_type
)
316 && XCONS (target_type
)->car
== QMULTIPLE
)
321 pairs
= XCONS (target_type
)->cdr
;
322 size
= XVECTOR (pairs
)->size
;
323 /* If the target is MULTIPLE, then target_type looks like
324 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
325 We modify the second element of each pair in the vector and
326 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
328 for (i
= 0; i
< size
; i
++)
331 pair
= XVECTOR (pairs
)->contents
[i
];
332 XVECTOR (pair
)->contents
[1]
333 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
334 XVECTOR (pair
)->contents
[1]);
341 /* Don't allow a quit within the converter.
342 When the user types C-g, he would be surprised
343 if by luck it came during a converter. */
344 count
= specpdl_ptr
- specpdl
;
345 specbind (Qinhibit_quit
, Qt
);
347 CHECK_SYMBOL (target_type
, 0);
348 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
349 if (!NILP (handler_fn
))
350 value
= call3 (handler_fn
,
351 selection_symbol
, target_type
,
352 XCONS (XCONS (local_value
)->cdr
)->car
);
355 unbind_to (count
, Qnil
);
358 /* Make sure this value is of a type that we could transmit
359 to another X client. */
363 && SYMBOLP (XCONS (value
)->car
))
364 type
= XCONS (value
)->car
,
365 check
= XCONS (value
)->cdr
;
373 /* Check for a value that cons_to_long could handle. */
374 else if (CONSP (check
)
375 && INTEGERP (XCONS (check
)->car
)
376 && (INTEGERP (XCONS (check
)->cdr
)
378 (CONSP (XCONS (check
)->cdr
)
379 && INTEGERP (XCONS (XCONS (check
)->cdr
)->car
)
380 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
385 Fcons (build_string ("invalid data returned by selection-conversion function"),
386 Fcons (handler_fn
, Fcons (value
, Qnil
))));
389 /* Subroutines of x_reply_selection_request. */
391 /* Send a SelectionNotify event to the requestor with property=None,
392 meaning we were unable to do what they wanted. */
395 x_decline_selection_request (event
)
396 struct input_event
*event
;
398 XSelectionEvent reply
;
399 reply
.type
= SelectionNotify
;
400 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
401 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
402 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
403 reply
.time
= SELECTION_EVENT_TIME (event
);
404 reply
.target
= SELECTION_EVENT_TARGET (event
);
405 reply
.property
= None
;
408 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
410 XFlush (reply
.display
);
414 /* This is the selection request currently being processed.
415 It is set to zero when the request is fully processed. */
416 static struct input_event
*x_selection_current_request
;
418 /* Used as an unwind-protect clause so that, if a selection-converter signals
419 an error, we tell the requestor that we were unable to do what they wanted
420 before we throw to top-level or go into the debugger or whatever. */
423 x_selection_request_lisp_error (ignore
)
426 if (x_selection_current_request
!= 0)
427 x_decline_selection_request (x_selection_current_request
);
432 /* This stuff is so that INCR selections are reentrant (that is, so we can
433 be servicing multiple INCR selection requests simultaneously.) I haven't
434 actually tested that yet. */
436 /* Keep a list of the property changes that are awaited. */
446 struct prop_location
*next
;
449 static struct prop_location
*expect_property_change ();
450 static void wait_for_property_change ();
451 static void unexpect_property_change ();
452 static int waiting_for_other_props_on_window ();
454 static int prop_location_identifier
;
456 static Lisp_Object property_change_reply
;
458 static struct prop_location
*property_change_reply_object
;
460 static struct prop_location
*property_change_wait_list
;
463 queue_selection_requests_unwind (frame
)
466 FRAME_PTR f
= XFRAME (frame
);
469 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
472 /* Return some frame whose display info is DPYINFO.
473 Return nil if there is none. */
476 some_frame_on_display (dpyinfo
)
477 struct x_display_info
*dpyinfo
;
479 Lisp_Object list
, frame
;
481 FOR_EACH_FRAME (list
, frame
)
483 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
490 /* Send the reply to a selection request event EVENT.
491 TYPE is the type of selection data requested.
492 DATA and SIZE describe the data to send, already converted.
493 FORMAT is the unit-size (in bits) of the data to be transmitted. */
496 x_reply_selection_request (event
, format
, data
, size
, type
)
497 struct input_event
*event
;
502 XSelectionEvent reply
;
503 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
504 Window window
= SELECTION_EVENT_REQUESTOR (event
);
506 int format_bytes
= format
/8;
507 int max_bytes
= SELECTION_QUANTUM (display
);
508 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
510 if (max_bytes
> MAX_SELECTION_QUANTUM
)
511 max_bytes
= MAX_SELECTION_QUANTUM
;
513 reply
.type
= SelectionNotify
;
514 reply
.display
= display
;
515 reply
.requestor
= window
;
516 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
517 reply
.time
= SELECTION_EVENT_TIME (event
);
518 reply
.target
= SELECTION_EVENT_TARGET (event
);
519 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
520 if (reply
.property
== None
)
521 reply
.property
= reply
.target
;
523 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
525 x_catch_errors (display
);
527 /* Store the data on the requested property.
528 If the selection is large, only store the first N bytes of it.
530 bytes_remaining
= size
* format_bytes
;
531 if (bytes_remaining
<= max_bytes
)
533 /* Send all the data at once, with minimal handshaking. */
535 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
537 XChangeProperty (display
, window
, reply
.property
, type
, format
,
538 PropModeReplace
, data
, size
);
539 /* At this point, the selection was successfully stored; ack it. */
540 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
544 /* Send an INCR selection. */
545 struct prop_location
*wait_object
;
547 int count
= specpdl_ptr
- specpdl
;
550 frame
= some_frame_on_display (dpyinfo
);
552 /* If the display no longer has frames, we can't expect
553 to get many more selection requests from it, so don't
554 bother trying to queue them. */
557 x_start_queuing_selection_requests (display
);
559 record_unwind_protect (queue_selection_requests_unwind
,
563 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
564 error ("attempt to transfer an INCR to ourself!");
566 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
568 wait_object
= expect_property_change (display
, window
, reply
.property
,
571 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
573 (unsigned char *) &bytes_remaining
, 1);
574 XSelectInput (display
, window
, PropertyChangeMask
);
575 /* Tell 'em the INCR data is there... */
576 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
579 had_errors
= x_had_errors_p (display
);
582 /* First, wait for the requestor to ack by deleting the property.
583 This can run random lisp code (process handlers) or signal. */
585 wait_for_property_change (wait_object
);
587 while (bytes_remaining
)
589 int i
= ((bytes_remaining
< max_bytes
)
596 = expect_property_change (display
, window
, reply
.property
,
599 fprintf (stderr
," INCR adding %d\n", i
);
601 /* Append the next chunk of data to the property. */
602 XChangeProperty (display
, window
, reply
.property
, type
, format
,
603 PropModeAppend
, data
, i
/ format_bytes
);
604 bytes_remaining
-= i
;
607 had_errors
= x_had_errors_p (display
);
613 /* Now wait for the requestor to ack this chunk by deleting the
614 property. This can run random lisp code or signal.
616 wait_for_property_change (wait_object
);
618 /* Now write a zero-length chunk to the property to tell the requestor
621 fprintf (stderr
," INCR done\n");
624 if (! waiting_for_other_props_on_window (display
, window
))
625 XSelectInput (display
, window
, 0L);
627 XChangeProperty (display
, window
, reply
.property
, type
, format
,
628 PropModeReplace
, data
, 0);
630 unbind_to (count
, Qnil
);
634 x_uncatch_errors (display
);
638 /* Handle a SelectionRequest event EVENT.
639 This is called from keyboard.c when such an event is found in the queue. */
642 x_handle_selection_request (event
)
643 struct input_event
*event
;
645 struct gcpro gcpro1
, gcpro2
, gcpro3
;
646 Lisp_Object local_selection_data
;
647 Lisp_Object selection_symbol
;
648 Lisp_Object target_symbol
;
649 Lisp_Object converted_selection
;
650 Time local_selection_time
;
651 Lisp_Object successful_p
;
653 struct x_display_info
*dpyinfo
654 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
656 local_selection_data
= Qnil
;
657 target_symbol
= Qnil
;
658 converted_selection
= Qnil
;
661 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
663 selection_symbol
= x_atom_to_symbol (dpyinfo
,
664 SELECTION_EVENT_DISPLAY (event
),
665 SELECTION_EVENT_SELECTION (event
));
667 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
669 if (NILP (local_selection_data
))
671 /* Someone asked for the selection, but we don't have it any more.
673 x_decline_selection_request (event
);
677 local_selection_time
= (Time
)
678 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
680 if (SELECTION_EVENT_TIME (event
) != CurrentTime
681 && local_selection_time
> SELECTION_EVENT_TIME (event
))
683 /* Someone asked for the selection, and we have one, but not the one
686 x_decline_selection_request (event
);
690 count
= specpdl_ptr
- specpdl
;
691 x_selection_current_request
= event
;
692 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
694 target_symbol
= x_atom_to_symbol (dpyinfo
, SELECTION_EVENT_DISPLAY (event
),
695 SELECTION_EVENT_TARGET (event
));
697 #if 0 /* #### MULTIPLE doesn't work yet */
698 if (EQ (target_symbol
, QMULTIPLE
))
699 target_symbol
= fetch_multiple_target (event
);
702 /* Convert lisp objects back into binary data */
705 = x_get_local_selection (selection_symbol
, target_symbol
);
707 if (! NILP (converted_selection
))
715 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
717 &data
, &type
, &size
, &format
, &nofree
);
719 x_reply_selection_request (event
, format
, data
, size
, type
);
722 /* Indicate we have successfully processed this event. */
723 x_selection_current_request
= 0;
728 unbind_to (count
, Qnil
);
734 /* Let random lisp code notice that the selection has been asked for. */
737 rest
= Vx_sent_selection_hooks
;
738 if (!EQ (rest
, Qunbound
))
739 for (; CONSP (rest
); rest
= Fcdr (rest
))
740 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
744 /* Handle a SelectionClear event EVENT, which indicates that some other
745 client cleared out our previously asserted selection.
746 This is called from keyboard.c when such an event is found in the queue. */
749 x_handle_selection_clear (event
)
750 struct input_event
*event
;
752 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
753 Atom selection
= SELECTION_EVENT_SELECTION (event
);
754 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
756 Lisp_Object selection_symbol
, local_selection_data
;
757 Time local_selection_time
;
758 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
760 selection_symbol
= x_atom_to_symbol (dpyinfo
, display
, selection
);
762 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
764 /* Well, we already believe that we don't own it, so that's just fine. */
765 if (NILP (local_selection_data
)) return;
767 local_selection_time
= (Time
)
768 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
770 /* This SelectionClear is for a selection that we no longer own, so we can
771 disregard it. (That is, we have reasserted the selection since this
772 request was generated.) */
774 if (changed_owner_time
!= CurrentTime
775 && local_selection_time
> changed_owner_time
)
778 /* Otherwise, we're really honest and truly being told to drop it.
779 Don't use Fdelq as that may QUIT;. */
781 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
782 Vselection_alist
= Fcdr (Vselection_alist
);
786 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
787 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
789 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
794 /* Let random lisp code notice that the selection has been stolen. */
798 rest
= Vx_lost_selection_hooks
;
799 if (!EQ (rest
, Qunbound
))
801 for (; CONSP (rest
); rest
= Fcdr (rest
))
802 call1 (Fcar (rest
), selection_symbol
);
803 prepare_menu_bars ();
804 redisplay_preserve_echo_area ();
809 /* Clear all selections that were made from frame F.
810 We do this when about to delete a frame. */
813 x_clear_frame_selections (f
)
819 XSETFRAME (frame
, f
);
821 /* Otherwise, we're really honest and truly being told to drop it.
822 Don't use Fdelq as that may QUIT;. */
824 while (!NILP (Vselection_alist
)
825 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
827 /* Let random Lisp code notice that the selection has been stolen. */
828 Lisp_Object hooks
, selection_symbol
;
830 hooks
= Vx_lost_selection_hooks
;
831 selection_symbol
= Fcar (Vselection_alist
);
833 if (!EQ (hooks
, Qunbound
))
835 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
836 call1 (Fcar (hooks
), selection_symbol
);
837 redisplay_preserve_echo_area ();
840 Vselection_alist
= Fcdr (Vselection_alist
);
843 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
844 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest
)->cdr
)))))))
846 /* Let random Lisp code notice that the selection has been stolen. */
847 Lisp_Object hooks
, selection_symbol
;
849 hooks
= Vx_lost_selection_hooks
;
850 selection_symbol
= Fcar (XCONS (rest
)->cdr
);
852 if (!EQ (hooks
, Qunbound
))
854 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
855 call1 (Fcar (hooks
), selection_symbol
);
856 redisplay_preserve_echo_area ();
858 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
863 /* Nonzero if any properties for DISPLAY and WINDOW
864 are on the list of what we are waiting for. */
867 waiting_for_other_props_on_window (display
, window
)
871 struct prop_location
*rest
= property_change_wait_list
;
873 if (rest
->display
== display
&& rest
->window
== window
)
880 /* Add an entry to the list of property changes we are waiting for.
881 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
882 The return value is a number that uniquely identifies
883 this awaited property change. */
885 static struct prop_location
*
886 expect_property_change (display
, window
, property
, state
)
889 Lisp_Object property
;
892 struct prop_location
*pl
893 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
894 pl
->identifier
= ++prop_location_identifier
;
895 pl
->display
= display
;
897 pl
->property
= property
;
898 pl
->desired_state
= state
;
899 pl
->next
= property_change_wait_list
;
901 property_change_wait_list
= pl
;
905 /* Delete an entry from the list of property changes we are waiting for.
906 IDENTIFIER is the number that uniquely identifies the entry. */
909 unexpect_property_change (location
)
910 struct prop_location
*location
;
912 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
915 if (rest
== location
)
918 prev
->next
= rest
->next
;
920 property_change_wait_list
= rest
->next
;
929 /* Remove the property change expectation element for IDENTIFIER. */
932 wait_for_property_change_unwind (identifierval
)
933 Lisp_Object identifierval
;
935 unexpect_property_change ((struct prop_location
*)
936 (XFASTINT (XCONS (identifierval
)->car
) << 16
937 | XFASTINT (XCONS (identifierval
)->cdr
)));
940 /* Actually wait for a property change.
941 IDENTIFIER should be the value that expect_property_change returned. */
944 wait_for_property_change (location
)
945 struct prop_location
*location
;
948 int count
= specpdl_ptr
- specpdl
;
951 tem
= Fcons (Qnil
, Qnil
);
952 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
953 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
955 /* Make sure to do unexpect_property_change if we quit or err. */
956 record_unwind_protect (wait_for_property_change_unwind
, tem
);
958 XCONS (property_change_reply
)->car
= Qnil
;
960 property_change_reply_object
= location
;
961 /* If the event we are waiting for arrives beyond here, it will set
962 property_change_reply, because property_change_reply_object says so. */
963 if (! location
->arrived
)
965 secs
= x_selection_timeout
/ 1000;
966 usecs
= (x_selection_timeout
% 1000) * 1000;
967 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
969 if (NILP (XCONS (property_change_reply
)->car
))
970 error ("timed out waiting for property-notify event");
973 unbind_to (count
, Qnil
);
976 /* Called from XTread_socket in response to a PropertyNotify event. */
979 x_handle_property_notify (event
)
980 XPropertyEvent
*event
;
982 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
985 if (rest
->property
== event
->atom
986 && rest
->window
== event
->window
987 && rest
->display
== event
->display
988 && rest
->desired_state
== event
->state
)
991 fprintf (stderr
, "Saw expected prop-%s on %s\n",
992 (event
->state
== PropertyDelete
? "delete" : "change"),
993 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
1000 /* If this is the one wait_for_property_change is waiting for,
1001 tell it to wake up. */
1002 if (rest
== property_change_reply_object
)
1003 XCONS (property_change_reply
)->car
= Qt
;
1006 prev
->next
= rest
->next
;
1008 property_change_wait_list
= rest
->next
;
1016 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
1017 (event
->state
== PropertyDelete
? "delete" : "change"),
1018 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
1019 event
->display
, event
->atom
))
1026 #if 0 /* #### MULTIPLE doesn't work yet */
1029 fetch_multiple_target (event
)
1030 XSelectionRequestEvent
*event
;
1032 Display
*display
= event
->display
;
1033 Window window
= event
->requestor
;
1034 Atom target
= event
->target
;
1035 Atom selection_atom
= event
->selection
;
1040 x_get_window_property_as_lisp_data (display
, window
, target
,
1041 QMULTIPLE
, selection_atom
));
1045 copy_multiple_data (obj
)
1052 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1054 CHECK_VECTOR (obj
, 0);
1055 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1056 for (i
= 0; i
< size
; i
++)
1058 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1059 CHECK_VECTOR (vec2
, 0);
1060 if (XVECTOR (vec2
)->size
!= 2)
1061 /* ??? Confusing error message */
1062 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1063 Fcons (vec2
, Qnil
)));
1064 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1065 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1066 = XVECTOR (vec2
)->contents
[0];
1067 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1068 = XVECTOR (vec2
)->contents
[1];
1076 /* Variables for communication with x_handle_selection_notify. */
1077 static Atom reading_which_selection
;
1078 static Lisp_Object reading_selection_reply
;
1079 static Window reading_selection_window
;
1081 /* Do protocol to read selection-data from the server.
1082 Converts this to Lisp data and returns it. */
1085 x_get_foreign_selection (selection_symbol
, target_type
)
1086 Lisp_Object selection_symbol
, target_type
;
1088 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1089 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1090 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1091 Time requestor_time
= last_event_timestamp
;
1092 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1093 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1096 int count
= specpdl_ptr
- specpdl
;
1099 if (CONSP (target_type
))
1100 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1102 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1105 x_catch_errors (display
);
1106 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1107 requestor_window
, requestor_time
);
1110 /* Prepare to block until the reply has been read. */
1111 reading_selection_window
= requestor_window
;
1112 reading_which_selection
= selection_atom
;
1113 XCONS (reading_selection_reply
)->car
= Qnil
;
1115 frame
= some_frame_on_display (dpyinfo
);
1117 /* If the display no longer has frames, we can't expect
1118 to get many more selection requests from it, so don't
1119 bother trying to queue them. */
1122 x_start_queuing_selection_requests (display
);
1124 record_unwind_protect (queue_selection_requests_unwind
,
1129 /* This allows quits. Also, don't wait forever. */
1130 secs
= x_selection_timeout
/ 1000;
1131 usecs
= (x_selection_timeout
% 1000) * 1000;
1132 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1135 x_check_errors (display
, "Cannot get selection: %s");
1136 x_uncatch_errors (display
);
1137 unbind_to (count
, Qnil
);
1140 if (NILP (XCONS (reading_selection_reply
)->car
))
1141 error ("timed out waiting for reply from selection owner");
1143 /* Otherwise, the selection is waiting for us on the requested property. */
1145 x_get_window_property_as_lisp_data (display
, requestor_window
,
1146 target_property
, target_type
,
1150 /* Subroutines of x_get_window_property_as_lisp_data */
1153 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1154 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1159 unsigned char **data_ret
;
1161 Atom
*actual_type_ret
;
1162 int *actual_format_ret
;
1163 unsigned long *actual_size_ret
;
1167 unsigned long bytes_remaining
;
1169 unsigned char *tmp_data
= 0;
1171 int buffer_size
= SELECTION_QUANTUM (display
);
1172 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1175 /* First probe the thing to find out how big it is. */
1176 result
= XGetWindowProperty (display
, window
, property
,
1177 0, 0, False
, AnyPropertyType
,
1178 actual_type_ret
, actual_format_ret
,
1180 &bytes_remaining
, &tmp_data
);
1181 if (result
!= Success
)
1188 xfree ((char *) tmp_data
);
1190 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1196 total_size
= bytes_remaining
+ 1;
1197 *data_ret
= (unsigned char *) xmalloc (total_size
);
1199 /* Now read, until weve gotten it all. */
1200 while (bytes_remaining
)
1203 int last
= bytes_remaining
;
1206 = XGetWindowProperty (display
, window
, property
,
1207 offset
/4, buffer_size
/4,
1210 actual_type_ret
, actual_format_ret
,
1211 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1213 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1215 /* If this doesn't return Success at this point, it means that
1216 some clod deleted the selection while we were in the midst of
1217 reading it. Deal with that, I guess....
1219 if (result
!= Success
) break;
1220 *actual_size_ret
*= *actual_format_ret
/ 8;
1221 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1222 offset
+= *actual_size_ret
;
1223 xfree ((char *) tmp_data
);
1228 *bytes_ret
= offset
;
1232 receive_incremental_selection (display
, window
, property
, target_type
,
1233 min_size_bytes
, data_ret
, size_bytes_ret
,
1234 type_ret
, format_ret
, size_ret
)
1238 Lisp_Object target_type
; /* for error messages only */
1239 unsigned int min_size_bytes
;
1240 unsigned char **data_ret
;
1241 int *size_bytes_ret
;
1243 unsigned long *size_ret
;
1247 struct prop_location
*wait_object
;
1248 *size_bytes_ret
= min_size_bytes
;
1249 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1251 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1254 /* At this point, we have read an INCR property.
1255 Delete the property to ack it.
1256 (But first, prepare to receive the next event in this handshake.)
1258 Now, we must loop, waiting for the sending window to put a value on
1259 that property, then reading the property, then deleting it to ack.
1260 We are done when the sender places a property of length 0.
1263 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1264 XDeleteProperty (display
, window
, property
);
1265 wait_object
= expect_property_change (display
, window
, property
,
1272 unsigned char *tmp_data
;
1274 wait_for_property_change (wait_object
);
1275 /* expect it again immediately, because x_get_window_property may
1276 .. no it wont, I dont get it.
1277 .. Ok, I get it now, the Xt code that implements INCR is broken.
1279 x_get_window_property (display
, window
, property
,
1280 &tmp_data
, &tmp_size_bytes
,
1281 type_ret
, format_ret
, size_ret
, 1);
1283 if (tmp_size_bytes
== 0) /* we're done */
1286 fprintf (stderr
, " read INCR done\n");
1288 if (! waiting_for_other_props_on_window (display
, window
))
1289 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1290 unexpect_property_change (wait_object
);
1291 if (tmp_data
) xfree (tmp_data
);
1296 XDeleteProperty (display
, window
, property
);
1297 wait_object
= expect_property_change (display
, window
, property
,
1303 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1305 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1308 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1309 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1311 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1312 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1314 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1315 offset
+= tmp_size_bytes
;
1320 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1321 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1322 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1325 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1330 Lisp_Object target_type
; /* for error messages only */
1331 Atom selection_atom
; /* for error messages only */
1335 unsigned long actual_size
;
1336 unsigned char *data
= 0;
1339 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1341 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1342 &actual_type
, &actual_format
, &actual_size
, 1);
1345 int there_is_a_selection_owner
;
1347 there_is_a_selection_owner
1348 = XGetSelectionOwner (display
, selection_atom
);
1350 while (1) /* Note debugger can no longer return, so this is obsolete */
1352 there_is_a_selection_owner
?
1353 Fcons (build_string ("selection owner couldn't convert"),
1355 ? Fcons (target_type
,
1356 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1359 : Fcons (target_type
, Qnil
))
1360 : Fcons (build_string ("no selection"),
1361 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1366 if (actual_type
== dpyinfo
->Xatom_INCR
)
1368 /* That wasn't really the data, just the beginning. */
1370 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1372 XFree ((char *) data
);
1374 receive_incremental_selection (display
, window
, property
, target_type
,
1375 min_size_bytes
, &data
, &bytes
,
1376 &actual_type
, &actual_format
,
1381 XDeleteProperty (display
, window
, property
);
1385 /* It's been read. Now convert it to a lisp object in some semi-rational
1387 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1388 actual_type
, actual_format
);
1390 xfree ((char *) data
);
1394 /* These functions convert from the selection data read from the server into
1395 something that we can use from Lisp, and vice versa.
1397 Type: Format: Size: Lisp Type:
1398 ----- ------- ----- -----------
1401 ATOM 32 > 1 Vector of Symbols
1403 * 16 > 1 Vector of Integers
1404 * 32 1 if <=16 bits: Integer
1405 if > 16 bits: Cons of top16, bot16
1406 * 32 > 1 Vector of the above
1408 When converting a Lisp number to C, it is assumed to be of format 16 if
1409 it is an integer, and of format 32 if it is a cons of two integers.
1411 When converting a vector of numbers from Lisp to C, it is assumed to be
1412 of format 16 if every element in the vector is an integer, and is assumed
1413 to be of format 32 if any element is a cons of two integers.
1415 When converting an object to C, it may be of the form (SYMBOL . <data>)
1416 where SYMBOL is what we should claim that the type is. Format and
1417 representation are as above. */
1422 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1424 unsigned char *data
;
1428 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1430 if (type
== dpyinfo
->Xatom_NULL
)
1433 /* Convert any 8-bit data to a string, for compactness. */
1434 else if (format
== 8)
1435 return make_string ((char *) data
, size
);
1437 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1438 a vector of symbols.
1440 else if (type
== XA_ATOM
)
1443 if (size
== sizeof (Atom
))
1444 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1447 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1448 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1449 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1450 ((Atom
*) data
) [i
]));
1455 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1456 If the number is > 16 bits, convert it to a cons of integers,
1457 16 bits in each half.
1459 else if (format
== 32 && size
== sizeof (long))
1460 return long_to_cons (((unsigned long *) data
) [0]);
1461 else if (format
== 16 && size
== sizeof (short))
1462 return make_number ((int) (((unsigned short *) data
) [0]));
1464 /* Convert any other kind of data to a vector of numbers, represented
1465 as above (as an integer, or a cons of two 16 bit integers.)
1467 else if (format
== 16)
1470 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1471 for (i
= 0; i
< size
/ 4; i
++)
1473 int j
= (int) ((unsigned short *) data
) [i
];
1474 Faset (v
, i
, make_number (j
));
1481 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1482 for (i
= 0; i
< size
/ 4; i
++)
1484 unsigned long j
= ((unsigned long *) data
) [i
];
1485 Faset (v
, i
, long_to_cons (j
));
1493 lisp_data_to_selection_data (display
, obj
,
1494 data_ret
, type_ret
, size_ret
,
1495 format_ret
, nofree_ret
)
1498 unsigned char **data_ret
;
1500 unsigned int *size_ret
;
1504 Lisp_Object type
= Qnil
;
1505 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1509 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1511 type
= XCONS (obj
)->car
;
1512 obj
= XCONS (obj
)->cdr
;
1513 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1514 obj
= XCONS (obj
)->car
;
1517 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1518 { /* This is not the same as declining */
1524 else if (STRINGP (obj
))
1527 *size_ret
= XSTRING (obj
)->size
;
1528 *data_ret
= XSTRING (obj
)->data
;
1530 if (NILP (type
)) type
= QSTRING
;
1532 else if (SYMBOLP (obj
))
1536 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1537 (*data_ret
) [sizeof (Atom
)] = 0;
1538 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1539 if (NILP (type
)) type
= QATOM
;
1541 else if (INTEGERP (obj
)
1542 && XINT (obj
) < 0xFFFF
1543 && XINT (obj
) > -0xFFFF)
1547 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1548 (*data_ret
) [sizeof (short)] = 0;
1549 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1550 if (NILP (type
)) type
= QINTEGER
;
1552 else if (INTEGERP (obj
)
1553 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1554 && (INTEGERP (XCONS (obj
)->cdr
)
1555 || (CONSP (XCONS (obj
)->cdr
)
1556 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1560 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1561 (*data_ret
) [sizeof (long)] = 0;
1562 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1563 if (NILP (type
)) type
= QINTEGER
;
1565 else if (VECTORP (obj
))
1567 /* Lisp_Vectors may represent a set of ATOMs;
1568 a set of 16 or 32 bit INTEGERs;
1569 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1573 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1574 /* This vector is an ATOM set */
1576 if (NILP (type
)) type
= QATOM
;
1577 *size_ret
= XVECTOR (obj
)->size
;
1579 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1580 for (i
= 0; i
< *size_ret
; i
++)
1581 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1582 (*(Atom
**) data_ret
) [i
]
1583 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1585 Fsignal (Qerror
, /* Qselection_error */
1587 ("all elements of selection vector must have same type"),
1588 Fcons (obj
, Qnil
)));
1590 #if 0 /* #### MULTIPLE doesn't work yet */
1591 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1592 /* This vector is an ATOM_PAIR set */
1594 if (NILP (type
)) type
= QATOM_PAIR
;
1595 *size_ret
= XVECTOR (obj
)->size
;
1597 *data_ret
= (unsigned char *)
1598 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1599 for (i
= 0; i
< *size_ret
; i
++)
1600 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1602 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1603 if (XVECTOR (pair
)->size
!= 2)
1606 ("elements of the vector must be vectors of exactly two elements"),
1607 Fcons (pair
, Qnil
)));
1609 (*(Atom
**) data_ret
) [i
* 2]
1610 = symbol_to_x_atom (dpyinfo
, display
,
1611 XVECTOR (pair
)->contents
[0]);
1612 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1613 = symbol_to_x_atom (dpyinfo
, display
,
1614 XVECTOR (pair
)->contents
[1]);
1619 ("all elements of the vector must be of the same type"),
1620 Fcons (obj
, Qnil
)));
1625 /* This vector is an INTEGER set, or something like it */
1627 *size_ret
= XVECTOR (obj
)->size
;
1628 if (NILP (type
)) type
= QINTEGER
;
1630 for (i
= 0; i
< *size_ret
; i
++)
1631 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1633 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1634 Fsignal (Qerror
, /* Qselection_error */
1636 ("elements of selection vector must be integers or conses of integers"),
1637 Fcons (obj
, Qnil
)));
1639 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1640 for (i
= 0; i
< *size_ret
; i
++)
1641 if (*format_ret
== 32)
1642 (*((unsigned long **) data_ret
)) [i
]
1643 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1645 (*((unsigned short **) data_ret
)) [i
]
1646 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1650 Fsignal (Qerror
, /* Qselection_error */
1651 Fcons (build_string ("unrecognised selection data"),
1652 Fcons (obj
, Qnil
)));
1654 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1658 clean_local_selection_data (obj
)
1662 && INTEGERP (XCONS (obj
)->car
)
1663 && CONSP (XCONS (obj
)->cdr
)
1664 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1665 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1666 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1669 && INTEGERP (XCONS (obj
)->car
)
1670 && INTEGERP (XCONS (obj
)->cdr
))
1672 if (XINT (XCONS (obj
)->car
) == 0)
1673 return XCONS (obj
)->cdr
;
1674 if (XINT (XCONS (obj
)->car
) == -1)
1675 return make_number (- XINT (XCONS (obj
)->cdr
));
1680 int size
= XVECTOR (obj
)->size
;
1683 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1684 copy
= Fmake_vector (size
, Qnil
);
1685 for (i
= 0; i
< size
; i
++)
1686 XVECTOR (copy
)->contents
[i
]
1687 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1693 /* Called from XTread_socket to handle SelectionNotify events.
1694 If it's the selection we are waiting for, stop waiting. */
1697 x_handle_selection_notify (event
)
1698 XSelectionEvent
*event
;
1700 if (event
->requestor
!= reading_selection_window
)
1702 if (event
->selection
!= reading_which_selection
)
1705 XCONS (reading_selection_reply
)->car
= Qt
;
1709 DEFUN ("x-own-selection-internal",
1710 Fx_own_selection_internal
, Sx_own_selection_internal
,
1712 "Assert an X selection of the given TYPE with the given VALUE.\n\
1713 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1714 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1715 VALUE is typically a string, or a cons of two markers, but may be\n\
1716 anything that the functions on `selection-converter-alist' know about.")
1717 (selection_name
, selection_value
)
1718 Lisp_Object selection_name
, selection_value
;
1721 CHECK_SYMBOL (selection_name
, 0);
1722 if (NILP (selection_value
)) error ("selection-value may not be nil.");
1723 x_own_selection (selection_name
, selection_value
);
1724 return selection_value
;
1728 /* Request the selection value from the owner. If we are the owner,
1729 simply return our selection value. If we are not the owner, this
1730 will block until all of the data has arrived. */
1732 DEFUN ("x-get-selection-internal",
1733 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1734 "Return text selected from some X window.\n\
1735 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1736 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1737 TYPE is the type of data desired, typically `STRING'.")
1738 (selection_symbol
, target_type
)
1739 Lisp_Object selection_symbol
, target_type
;
1741 Lisp_Object val
= Qnil
;
1742 struct gcpro gcpro1
, gcpro2
;
1743 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1745 CHECK_SYMBOL (selection_symbol
, 0);
1747 #if 0 /* #### MULTIPLE doesn't work yet */
1748 if (CONSP (target_type
)
1749 && XCONS (target_type
)->car
== QMULTIPLE
)
1751 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1752 /* So we don't destructively modify this... */
1753 target_type
= copy_multiple_data (target_type
);
1757 CHECK_SYMBOL (target_type
, 0);
1759 val
= x_get_local_selection (selection_symbol
, target_type
);
1763 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1768 && SYMBOLP (XCONS (val
)->car
))
1770 val
= XCONS (val
)->cdr
;
1771 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1772 val
= XCONS (val
)->car
;
1774 val
= clean_local_selection_data (val
);
1780 DEFUN ("x-disown-selection-internal",
1781 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1782 "If we own the selection SELECTION, disown it.\n\
1783 Disowning it means there is no such selection.")
1785 Lisp_Object selection
;
1789 Atom selection_atom
;
1790 XSelectionClearEvent event
;
1792 struct x_display_info
*dpyinfo
;
1795 display
= FRAME_X_DISPLAY (selected_frame
);
1796 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1797 CHECK_SYMBOL (selection
, 0);
1799 timestamp
= last_event_timestamp
;
1801 timestamp
= cons_to_long (time
);
1803 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1804 return Qnil
; /* Don't disown the selection when we're not the owner. */
1806 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1809 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1812 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1813 generated for a window which owns the selection when that window sets
1814 the selection owner to None. The NCD server does, the MIT Sun4 server
1815 doesn't. So we synthesize one; this means we might get two, but
1816 that's ok, because the second one won't have any effect. */
1817 SELECTION_EVENT_DISPLAY (&event
) = display
;
1818 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1819 SELECTION_EVENT_TIME (&event
) = timestamp
;
1820 x_handle_selection_clear (&event
);
1825 /* Get rid of all the selections in buffer BUFFER.
1826 This is used when we kill a buffer. */
1829 x_disown_buffer_selections (buffer
)
1833 struct buffer
*buf
= XBUFFER (buffer
);
1835 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1837 Lisp_Object elt
, value
;
1838 elt
= XCONS (tail
)->car
;
1839 value
= XCONS (elt
)->cdr
;
1840 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1841 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1842 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1846 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1848 "Whether the current Emacs process owns the given X Selection.\n\
1849 The arg should be the name of the selection in question, typically one of\n\
1850 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1851 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1852 For convenience, the symbol nil is the same as `PRIMARY',\n\
1853 and t is the same as `SECONDARY'.)")
1855 Lisp_Object selection
;
1858 CHECK_SYMBOL (selection
, 0);
1859 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1860 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1862 if (NILP (Fassq (selection
, Vselection_alist
)))
1867 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1869 "Whether there is an owner for the given X Selection.\n\
1870 The arg should be the name of the selection in question, typically one of\n\
1871 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1872 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1873 For convenience, the symbol nil is the same as `PRIMARY',\n\
1874 and t is the same as `SECONDARY'.)")
1876 Lisp_Object selection
;
1882 /* It should be safe to call this before we have an X frame. */
1883 if (! FRAME_X_P (selected_frame
))
1886 dpy
= FRAME_X_DISPLAY (selected_frame
);
1887 CHECK_SYMBOL (selection
, 0);
1888 if (!NILP (Fx_selection_owner_p (selection
)))
1890 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1891 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1892 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1897 owner
= XGetSelectionOwner (dpy
, atom
);
1899 return (owner
? Qt
: Qnil
);
1903 #ifdef CUT_BUFFER_SUPPORT
1905 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1907 initialize_cut_buffers (display
, window
)
1911 unsigned char *data
= (unsigned char *) "";
1913 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1914 PropModeAppend, data, 0)
1915 FROB (XA_CUT_BUFFER0
);
1916 FROB (XA_CUT_BUFFER1
);
1917 FROB (XA_CUT_BUFFER2
);
1918 FROB (XA_CUT_BUFFER3
);
1919 FROB (XA_CUT_BUFFER4
);
1920 FROB (XA_CUT_BUFFER5
);
1921 FROB (XA_CUT_BUFFER6
);
1922 FROB (XA_CUT_BUFFER7
);
1928 #define CHECK_CUT_BUFFER(symbol,n) \
1929 { CHECK_SYMBOL ((symbol), (n)); \
1930 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1931 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1932 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1933 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1935 Fcons (build_string ("doesn't name a cut buffer"), \
1936 Fcons ((symbol), Qnil))); \
1939 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1940 Sx_get_cut_buffer_internal
, 1, 1, 0,
1941 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1947 unsigned char *data
;
1954 struct x_display_info
*dpyinfo
;
1957 display
= FRAME_X_DISPLAY (selected_frame
);
1958 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1959 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1960 CHECK_CUT_BUFFER (buffer
, 0);
1961 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1963 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1964 &type
, &format
, &size
, 0);
1965 if (!data
) return Qnil
;
1967 if (format
!= 8 || type
!= XA_STRING
)
1969 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1970 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
1971 Fcons (make_number (format
), Qnil
))));
1973 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1979 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
1980 Sx_store_cut_buffer_internal
, 2, 2, 0,
1981 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1983 Lisp_Object buffer
, string
;
1987 unsigned char *data
;
1989 int bytes_remaining
;
1994 display
= FRAME_X_DISPLAY (selected_frame
);
1995 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1997 max_bytes
= SELECTION_QUANTUM (display
);
1998 if (max_bytes
> MAX_SELECTION_QUANTUM
)
1999 max_bytes
= MAX_SELECTION_QUANTUM
;
2001 CHECK_CUT_BUFFER (buffer
, 0);
2002 CHECK_STRING (string
, 0);
2003 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
2005 data
= (unsigned char *) XSTRING (string
)->data
;
2006 bytes
= XSTRING (string
)->size
;
2007 bytes_remaining
= bytes
;
2009 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2011 initialize_cut_buffers (display
, window
);
2012 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2017 /* Don't mess up with an empty value. */
2018 if (!bytes_remaining
)
2019 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2020 PropModeReplace
, data
, 0);
2022 while (bytes_remaining
)
2024 int chunk
= (bytes_remaining
< max_bytes
2025 ? bytes_remaining
: max_bytes
);
2026 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2027 (bytes_remaining
== bytes
2032 bytes_remaining
-= chunk
;
2039 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2040 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2041 "Rotate the values of the cut buffers by the given number of steps;\n\
2042 positive means move values forward, negative means backward.")
2051 display
= FRAME_X_DISPLAY (selected_frame
);
2052 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2053 CHECK_NUMBER (n
, 0);
2056 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2058 initialize_cut_buffers (display
, window
);
2059 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2062 props
[0] = XA_CUT_BUFFER0
;
2063 props
[1] = XA_CUT_BUFFER1
;
2064 props
[2] = XA_CUT_BUFFER2
;
2065 props
[3] = XA_CUT_BUFFER3
;
2066 props
[4] = XA_CUT_BUFFER4
;
2067 props
[5] = XA_CUT_BUFFER5
;
2068 props
[6] = XA_CUT_BUFFER6
;
2069 props
[7] = XA_CUT_BUFFER7
;
2071 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2081 defsubr (&Sx_get_selection_internal
);
2082 defsubr (&Sx_own_selection_internal
);
2083 defsubr (&Sx_disown_selection_internal
);
2084 defsubr (&Sx_selection_owner_p
);
2085 defsubr (&Sx_selection_exists_p
);
2087 #ifdef CUT_BUFFER_SUPPORT
2088 defsubr (&Sx_get_cut_buffer_internal
);
2089 defsubr (&Sx_store_cut_buffer_internal
);
2090 defsubr (&Sx_rotate_cut_buffers_internal
);
2093 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2094 staticpro (&reading_selection_reply
);
2095 reading_selection_window
= 0;
2096 reading_which_selection
= 0;
2098 property_change_wait_list
= 0;
2099 prop_location_identifier
= 0;
2100 property_change_reply
= Fcons (Qnil
, Qnil
);
2101 staticpro (&property_change_reply
);
2103 Vselection_alist
= Qnil
;
2104 staticpro (&Vselection_alist
);
2106 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2107 "An alist associating X Windows selection-types with functions.\n\
2108 These functions are called to convert the selection, with three args:\n\
2109 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2110 a desired type to which the selection should be converted;\n\
2111 and the local selection value (whatever was given to `x-own-selection').\n\
2113 The function should return the value to send to the X server\n\
2114 \(typically a string). A return value of nil\n\
2115 means that the conversion could not be done.\n\
2116 A return value which is the symbol `NULL'\n\
2117 means that a side-effect was executed,\n\
2118 and there is no meaningful selection value.");
2119 Vselection_converter_alist
= Qnil
;
2121 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2122 "A list of functions to be called when Emacs loses an X selection.\n\
2123 \(This happens when some other X client makes its own selection\n\
2124 or when a Lisp program explicitly clears the selection.)\n\
2125 The functions are called with one argument, the selection type\n\
2126 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
2127 Vx_lost_selection_hooks
= Qnil
;
2129 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2130 "A list of functions to be called when Emacs answers a selection request.\n\
2131 The functions are called with four arguments:\n\
2132 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2133 - the selection-type which Emacs was asked to convert the\n\
2134 selection into before sending (for example, `STRING' or `LENGTH');\n\
2135 - a flag indicating success or failure for responding to the request.\n\
2136 We might have failed (and declined the request) for any number of reasons,\n\
2137 including being asked for a selection that we no longer own, or being asked\n\
2138 to convert into a type that we don't know about or that is inappropriate.\n\
2139 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2140 it merely informs you that they have happened.");
2141 Vx_sent_selection_hooks
= Qnil
;
2143 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2144 "Number of milliseconds to wait for a selection reply.\n\
2145 If the selection owner doens't reply in this time, we give up.\n\
2146 A value of 0 means wait as long as necessary. This is initialized from the\n\
2147 \"*selectionTimeout\" resource.");
2148 x_selection_timeout
= 0;
2150 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2151 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2152 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2153 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2154 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2155 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2156 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2157 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2158 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2159 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2160 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2161 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2162 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2163 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2164 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2165 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2167 #ifdef CUT_BUFFER_SUPPORT
2168 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2169 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2170 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2171 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2172 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2173 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2174 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2175 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);