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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* Rewritten by jwz */
26 #include "xterm.h" /* for all of the X includes */
27 #include "dispextern.h" /* frame.h seems to want this */
28 #include "frame.h" /* Need this to get the X window of selected_frame */
29 #include "blockinput.h"
33 #define CUT_BUFFER_SUPPORT
35 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
36 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
39 #ifdef CUT_BUFFER_SUPPORT
40 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
41 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
44 static Lisp_Object Vx_lost_selection_hooks
;
45 static Lisp_Object Vx_sent_selection_hooks
;
47 /* If this is a smaller number than the max-request-size of the display,
48 emacs will use INCR selection transfer when the selection is larger
49 than this. The max-request-size is usually around 64k, so if you want
50 emacs to use incremental selection transfers when the selection is
51 smaller than that, set this. I added this mostly for debugging the
52 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
76 static Lisp_Object Vselection_alist
;
78 /* This is an alist whose CARs are selection-types (whose names are the same
79 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
80 call to convert the given Emacs selection value to a string representing
81 the given selection type. This is for Lisp-level extension of the emacs
82 selection handling. */
83 static Lisp_Object Vselection_converter_alist
;
85 /* If the selection owner takes too long to reply to a selection request,
86 we give up on it. This is in milliseconds (0 = no timeout.) */
87 static int x_selection_timeout
;
89 /* Utility functions */
91 static void lisp_data_to_selection_data ();
92 static Lisp_Object
selection_data_to_lisp_data ();
93 static Lisp_Object
x_get_window_property_as_lisp_data ();
95 /* This converts a Lisp symbol to a server Atom, avoiding a server
96 roundtrip whenever possible. */
99 symbol_to_x_atom (dpyinfo
, display
, sym
)
100 struct x_display_info
*dpyinfo
;
105 if (NILP (sym
)) return 0;
106 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
107 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
108 if (EQ (sym
, QSTRING
)) return XA_STRING
;
109 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
110 if (EQ (sym
, QATOM
)) return XA_ATOM
;
111 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
112 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
113 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
114 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
115 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
116 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
117 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
118 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
119 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
120 #ifdef CUT_BUFFER_SUPPORT
121 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
122 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
123 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
124 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
125 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
126 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
127 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
128 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
130 if (!SYMBOLP (sym
)) abort ();
133 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
136 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
142 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
143 and calls to intern whenever possible. */
146 x_atom_to_symbol (dpyinfo
, display
, atom
)
147 struct x_display_info
*dpyinfo
;
153 if (! atom
) return Qnil
;
166 #ifdef CUT_BUFFER_SUPPORT
186 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
188 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
190 if (atom
== dpyinfo
->Xatom_TEXT
)
192 if (atom
== dpyinfo
->Xatom_DELETE
)
194 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
196 if (atom
== dpyinfo
->Xatom_INCR
)
198 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
200 if (atom
== dpyinfo
->Xatom_TARGETS
)
202 if (atom
== dpyinfo
->Xatom_NULL
)
206 str
= XGetAtomName (display
, atom
);
209 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
211 if (! str
) return Qnil
;
219 /* Do protocol to assert ourself as a selection owner.
220 Update the Vselection_alist so that we can reply to later requests for
224 x_own_selection (selection_name
, selection_value
)
225 Lisp_Object selection_name
, selection_value
;
227 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
228 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
229 Time time
= last_event_timestamp
;
231 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
233 CHECK_SYMBOL (selection_name
, 0);
234 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
237 x_catch_errors (display
);
238 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
239 x_check_errors (display
, "Can't set selection: %s");
240 x_uncatch_errors (display
);
243 /* Now update the local cache */
245 Lisp_Object selection_time
;
246 Lisp_Object selection_data
;
247 Lisp_Object prev_value
;
249 selection_time
= long_to_cons ((unsigned long) time
);
250 selection_data
= Fcons (selection_name
,
251 Fcons (selection_value
,
252 Fcons (selection_time
,
253 Fcons (Fselected_frame (), Qnil
))));
254 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
256 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
258 /* If we already owned the selection, remove the old selection data.
259 Perhaps we should destructively modify it instead.
260 Don't use Fdelq as that may QUIT. */
261 if (!NILP (prev_value
))
263 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
264 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
265 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
267 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
274 /* Given a selection-name and desired type, look up our local copy of
275 the selection value and convert it to the type.
276 The value is nil or a string.
277 This function is used both for remote requests
278 and for local x-get-selection-internal.
280 This calls random Lisp code, and may signal or gc. */
283 x_get_local_selection (selection_symbol
, target_type
)
284 Lisp_Object selection_symbol
, target_type
;
286 Lisp_Object local_value
;
287 Lisp_Object handler_fn
, value
, type
, check
;
290 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
292 if (NILP (local_value
)) return Qnil
;
294 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
295 if (EQ (target_type
, QTIMESTAMP
))
298 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
301 else if (EQ (target_type
, QDELETE
))
304 Fx_disown_selection_internal
306 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
311 #if 0 /* #### MULTIPLE doesn't work yet */
312 else if (CONSP (target_type
)
313 && XCONS (target_type
)->car
== QMULTIPLE
)
318 pairs
= XCONS (target_type
)->cdr
;
319 size
= XVECTOR (pairs
)->size
;
320 /* If the target is MULTIPLE, then target_type looks like
321 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
322 We modify the second element of each pair in the vector and
323 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
325 for (i
= 0; i
< size
; i
++)
328 pair
= XVECTOR (pairs
)->contents
[i
];
329 XVECTOR (pair
)->contents
[1]
330 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
331 XVECTOR (pair
)->contents
[1]);
338 /* Don't allow a quit within the converter.
339 When the user types C-g, he would be surprised
340 if by luck it came during a converter. */
341 count
= specpdl_ptr
- specpdl
;
342 specbind (Qinhibit_quit
, Qt
);
344 CHECK_SYMBOL (target_type
, 0);
345 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
346 if (!NILP (handler_fn
))
347 value
= call3 (handler_fn
,
348 selection_symbol
, target_type
,
349 XCONS (XCONS (local_value
)->cdr
)->car
);
352 unbind_to (count
, Qnil
);
355 /* Make sure this value is of a type that we could transmit
356 to another X client. */
360 && SYMBOLP (XCONS (value
)->car
))
361 type
= XCONS (value
)->car
,
362 check
= XCONS (value
)->cdr
;
370 /* Check for a value that cons_to_long could handle. */
371 else if (CONSP (check
)
372 && INTEGERP (XCONS (check
)->car
)
373 && (INTEGERP (XCONS (check
)->cdr
)
375 (CONSP (XCONS (check
)->cdr
)
376 && INTEGERP (XCONS (XCONS (check
)->cdr
)->car
)
377 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
382 Fcons (build_string ("invalid data returned by selection-conversion function"),
383 Fcons (handler_fn
, Fcons (value
, Qnil
))));
386 /* Subroutines of x_reply_selection_request. */
388 /* Send a SelectionNotify event to the requestor with property=None,
389 meaning we were unable to do what they wanted. */
392 x_decline_selection_request (event
)
393 struct input_event
*event
;
395 XSelectionEvent reply
;
396 reply
.type
= SelectionNotify
;
397 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
398 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
399 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
400 reply
.time
= SELECTION_EVENT_TIME (event
);
401 reply
.target
= SELECTION_EVENT_TARGET (event
);
402 reply
.property
= None
;
405 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
407 XFlush (reply
.display
);
411 /* This is the selection request currently being processed.
412 It is set to zero when the request is fully processed. */
413 static struct input_event
*x_selection_current_request
;
415 /* Used as an unwind-protect clause so that, if a selection-converter signals
416 an error, we tell the requester that we were unable to do what they wanted
417 before we throw to top-level or go into the debugger or whatever. */
420 x_selection_request_lisp_error (ignore
)
423 if (x_selection_current_request
!= 0)
424 x_decline_selection_request (x_selection_current_request
);
429 /* This stuff is so that INCR selections are reentrant (that is, so we can
430 be servicing multiple INCR selection requests simultaneously.) I haven't
431 actually tested that yet. */
433 /* Keep a list of the property changes that are awaited. */
443 struct prop_location
*next
;
446 static struct prop_location
*expect_property_change ();
447 static void wait_for_property_change ();
448 static void unexpect_property_change ();
449 static int waiting_for_other_props_on_window ();
451 static int prop_location_identifier
;
453 static Lisp_Object property_change_reply
;
455 static struct prop_location
*property_change_reply_object
;
457 static struct prop_location
*property_change_wait_list
;
460 queue_selection_requests_unwind (frame
)
463 FRAME_PTR f
= XFRAME (frame
);
466 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
470 /* Return some frame whose display info is DPYINFO.
471 Return nil if there is none. */
474 some_frame_on_display (dpyinfo
)
475 struct x_display_info
*dpyinfo
;
477 Lisp_Object list
, frame
;
479 FOR_EACH_FRAME (list
, frame
)
481 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
488 /* Send the reply to a selection request event EVENT.
489 TYPE is the type of selection data requested.
490 DATA and SIZE describe the data to send, already converted.
491 FORMAT is the unit-size (in bits) of the data to be transmitted. */
494 x_reply_selection_request (event
, format
, data
, size
, type
)
495 struct input_event
*event
;
500 XSelectionEvent reply
;
501 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
502 Window window
= SELECTION_EVENT_REQUESTOR (event
);
504 int format_bytes
= format
/8;
505 int max_bytes
= SELECTION_QUANTUM (display
);
506 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
508 if (max_bytes
> MAX_SELECTION_QUANTUM
)
509 max_bytes
= MAX_SELECTION_QUANTUM
;
511 reply
.type
= SelectionNotify
;
512 reply
.display
= display
;
513 reply
.requestor
= window
;
514 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
515 reply
.time
= SELECTION_EVENT_TIME (event
);
516 reply
.target
= SELECTION_EVENT_TARGET (event
);
517 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
518 if (reply
.property
== None
)
519 reply
.property
= reply
.target
;
521 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
523 x_catch_errors (display
);
525 /* Store the data on the requested property.
526 If the selection is large, only store the first N bytes of it.
528 bytes_remaining
= size
* format_bytes
;
529 if (bytes_remaining
<= max_bytes
)
531 /* Send all the data at once, with minimal handshaking. */
533 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
535 XChangeProperty (display
, window
, reply
.property
, type
, format
,
536 PropModeReplace
, data
, size
);
537 /* At this point, the selection was successfully stored; ack it. */
538 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
542 /* Send an INCR selection. */
543 struct prop_location
*wait_object
;
545 int count
= specpdl_ptr
- specpdl
;
548 frame
= some_frame_on_display (dpyinfo
);
550 /* If the display no longer has frames, we can't expect
551 to get many more selection requests from it, so don't
552 bother trying to queue them. */
555 x_start_queuing_selection_requests (display
);
557 record_unwind_protect (queue_selection_requests_unwind
,
561 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
562 error ("Attempt to transfer an INCR to ourself!");
564 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
566 wait_object
= expect_property_change (display
, window
, reply
.property
,
569 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
571 (unsigned char *) &bytes_remaining
, 1);
572 XSelectInput (display
, window
, PropertyChangeMask
);
573 /* Tell 'em the INCR data is there... */
574 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
577 had_errors
= x_had_errors_p (display
);
580 /* First, wait for the requester to ack by deleting the property.
581 This can run random lisp code (process handlers) or signal. */
583 wait_for_property_change (wait_object
);
585 while (bytes_remaining
)
587 int i
= ((bytes_remaining
< max_bytes
)
594 = expect_property_change (display
, window
, reply
.property
,
597 fprintf (stderr
," INCR adding %d\n", i
);
599 /* Append the next chunk of data to the property. */
600 XChangeProperty (display
, window
, reply
.property
, type
, format
,
601 PropModeAppend
, data
, i
/ format_bytes
);
602 bytes_remaining
-= i
;
605 had_errors
= x_had_errors_p (display
);
611 /* Now wait for the requester to ack this chunk by deleting the
612 property. This can run random lisp code or signal.
614 wait_for_property_change (wait_object
);
616 /* Now write a zero-length chunk to the property to tell the requester
619 fprintf (stderr
," INCR done\n");
622 if (! waiting_for_other_props_on_window (display
, window
))
623 XSelectInput (display
, window
, 0L);
625 XChangeProperty (display
, window
, reply
.property
, type
, format
,
626 PropModeReplace
, data
, 0);
628 unbind_to (count
, Qnil
);
632 x_uncatch_errors (display
);
636 /* Handle a SelectionRequest event EVENT.
637 This is called from keyboard.c when such an event is found in the queue. */
640 x_handle_selection_request (event
)
641 struct input_event
*event
;
643 struct gcpro gcpro1
, gcpro2
, gcpro3
;
644 Lisp_Object local_selection_data
;
645 Lisp_Object selection_symbol
;
646 Lisp_Object target_symbol
;
647 Lisp_Object converted_selection
;
648 Time local_selection_time
;
649 Lisp_Object successful_p
;
651 struct x_display_info
*dpyinfo
652 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
654 local_selection_data
= Qnil
;
655 target_symbol
= Qnil
;
656 converted_selection
= Qnil
;
659 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
661 selection_symbol
= x_atom_to_symbol (dpyinfo
,
662 SELECTION_EVENT_DISPLAY (event
),
663 SELECTION_EVENT_SELECTION (event
));
665 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
667 if (NILP (local_selection_data
))
669 /* Someone asked for the selection, but we don't have it any more.
671 x_decline_selection_request (event
);
675 local_selection_time
= (Time
)
676 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
678 if (SELECTION_EVENT_TIME (event
) != CurrentTime
679 && local_selection_time
> SELECTION_EVENT_TIME (event
))
681 /* Someone asked for the selection, and we have one, but not the one
684 x_decline_selection_request (event
);
688 count
= specpdl_ptr
- specpdl
;
689 x_selection_current_request
= event
;
690 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
692 target_symbol
= x_atom_to_symbol (dpyinfo
, SELECTION_EVENT_DISPLAY (event
),
693 SELECTION_EVENT_TARGET (event
));
695 #if 0 /* #### MULTIPLE doesn't work yet */
696 if (EQ (target_symbol
, QMULTIPLE
))
697 target_symbol
= fetch_multiple_target (event
);
700 /* Convert lisp objects back into binary data */
703 = x_get_local_selection (selection_symbol
, target_symbol
);
705 if (! NILP (converted_selection
))
713 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
715 &data
, &type
, &size
, &format
, &nofree
);
717 x_reply_selection_request (event
, format
, data
, size
, type
);
720 /* Indicate we have successfully processed this event. */
721 x_selection_current_request
= 0;
726 unbind_to (count
, Qnil
);
732 /* Let random lisp code notice that the selection has been asked for. */
735 rest
= Vx_sent_selection_hooks
;
736 if (!EQ (rest
, Qunbound
))
737 for (; CONSP (rest
); rest
= Fcdr (rest
))
738 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
742 /* Handle a SelectionClear event EVENT, which indicates that some other
743 client cleared out our previously asserted selection.
744 This is called from keyboard.c when such an event is found in the queue. */
747 x_handle_selection_clear (event
)
748 struct input_event
*event
;
750 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
751 Atom selection
= SELECTION_EVENT_SELECTION (event
);
752 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
754 Lisp_Object selection_symbol
, local_selection_data
;
755 Time local_selection_time
;
756 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
758 selection_symbol
= x_atom_to_symbol (dpyinfo
, display
, selection
);
760 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
762 /* Well, we already believe that we don't own it, so that's just fine. */
763 if (NILP (local_selection_data
)) return;
765 local_selection_time
= (Time
)
766 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
768 /* This SelectionClear is for a selection that we no longer own, so we can
769 disregard it. (That is, we have reasserted the selection since this
770 request was generated.) */
772 if (changed_owner_time
!= CurrentTime
773 && local_selection_time
> changed_owner_time
)
776 /* Otherwise, we're really honest and truly being told to drop it.
777 Don't use Fdelq as that may QUIT;. */
779 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
780 Vselection_alist
= Fcdr (Vselection_alist
);
784 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
785 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
787 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
792 /* Let random lisp code notice that the selection has been stolen. */
796 rest
= Vx_lost_selection_hooks
;
797 if (!EQ (rest
, Qunbound
))
799 for (; CONSP (rest
); rest
= Fcdr (rest
))
800 call1 (Fcar (rest
), selection_symbol
);
801 prepare_menu_bars ();
802 redisplay_preserve_echo_area ();
807 /* Clear all selections that were made from frame F.
808 We do this when about to delete a frame. */
811 x_clear_frame_selections (f
)
817 XSETFRAME (frame
, f
);
819 /* Otherwise, we're really honest and truly being told to drop it.
820 Don't use Fdelq as that may QUIT;. */
822 /* Delete elements from the beginning of Vselection_alist. */
823 while (!NILP (Vselection_alist
)
824 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
826 /* Let random Lisp code notice that the selection has been stolen. */
827 Lisp_Object hooks
, selection_symbol
;
829 hooks
= Vx_lost_selection_hooks
;
830 selection_symbol
= Fcar (Fcar (Vselection_alist
));
832 if (!EQ (hooks
, Qunbound
))
834 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
835 call1 (Fcar (hooks
), selection_symbol
);
836 redisplay_preserve_echo_area ();
839 Vselection_alist
= Fcdr (Vselection_alist
);
842 /* Delete elements after the beginning of 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 (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
)));
941 /* Actually wait for a property change.
942 IDENTIFIER should be the value that expect_property_change returned. */
945 wait_for_property_change (location
)
946 struct prop_location
*location
;
949 int count
= specpdl_ptr
- specpdl
;
952 tem
= Fcons (Qnil
, Qnil
);
953 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
954 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
956 /* Make sure to do unexpect_property_change if we quit or err. */
957 record_unwind_protect (wait_for_property_change_unwind
, tem
);
959 XCONS (property_change_reply
)->car
= Qnil
;
961 property_change_reply_object
= location
;
962 /* If the event we are waiting for arrives beyond here, it will set
963 property_change_reply, because property_change_reply_object says so. */
964 if (! location
->arrived
)
966 secs
= x_selection_timeout
/ 1000;
967 usecs
= (x_selection_timeout
% 1000) * 1000;
968 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
970 if (NILP (XCONS (property_change_reply
)->car
))
971 error ("Timed out waiting for property-notify event");
974 unbind_to (count
, Qnil
);
977 /* Called from XTread_socket in response to a PropertyNotify event. */
980 x_handle_property_notify (event
)
981 XPropertyEvent
*event
;
983 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
986 if (rest
->property
== event
->atom
987 && rest
->window
== event
->window
988 && rest
->display
== event
->display
989 && rest
->desired_state
== event
->state
)
992 fprintf (stderr
, "Saw expected prop-%s on %s\n",
993 (event
->state
== PropertyDelete
? "delete" : "change"),
994 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
1001 /* If this is the one wait_for_property_change is waiting for,
1002 tell it to wake up. */
1003 if (rest
== property_change_reply_object
)
1004 XCONS (property_change_reply
)->car
= Qt
;
1007 prev
->next
= rest
->next
;
1009 property_change_wait_list
= rest
->next
;
1017 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
1018 (event
->state
== PropertyDelete
? "delete" : "change"),
1019 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
1020 event
->display
, event
->atom
))
1027 #if 0 /* #### MULTIPLE doesn't work yet */
1030 fetch_multiple_target (event
)
1031 XSelectionRequestEvent
*event
;
1033 Display
*display
= event
->display
;
1034 Window window
= event
->requestor
;
1035 Atom target
= event
->target
;
1036 Atom selection_atom
= event
->selection
;
1041 x_get_window_property_as_lisp_data (display
, window
, target
,
1042 QMULTIPLE
, selection_atom
));
1046 copy_multiple_data (obj
)
1053 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1055 CHECK_VECTOR (obj
, 0);
1056 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1057 for (i
= 0; i
< size
; i
++)
1059 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1060 CHECK_VECTOR (vec2
, 0);
1061 if (XVECTOR (vec2
)->size
!= 2)
1062 /* ??? Confusing error message */
1063 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1064 Fcons (vec2
, Qnil
)));
1065 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1066 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1067 = XVECTOR (vec2
)->contents
[0];
1068 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1069 = XVECTOR (vec2
)->contents
[1];
1077 /* Variables for communication with x_handle_selection_notify. */
1078 static Atom reading_which_selection
;
1079 static Lisp_Object reading_selection_reply
;
1080 static Window reading_selection_window
;
1082 /* Do protocol to read selection-data from the server.
1083 Converts this to Lisp data and returns it. */
1086 x_get_foreign_selection (selection_symbol
, target_type
)
1087 Lisp_Object selection_symbol
, target_type
;
1089 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1090 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1091 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1092 Time requestor_time
= last_event_timestamp
;
1093 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1094 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1097 int count
= specpdl_ptr
- specpdl
;
1100 if (CONSP (target_type
))
1101 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1103 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1106 x_catch_errors (display
);
1107 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1108 requestor_window
, requestor_time
);
1111 /* Prepare to block until the reply has been read. */
1112 reading_selection_window
= requestor_window
;
1113 reading_which_selection
= selection_atom
;
1114 XCONS (reading_selection_reply
)->car
= Qnil
;
1116 frame
= some_frame_on_display (dpyinfo
);
1118 /* If the display no longer has frames, we can't expect
1119 to get many more selection requests from it, so don't
1120 bother trying to queue them. */
1123 x_start_queuing_selection_requests (display
);
1125 record_unwind_protect (queue_selection_requests_unwind
,
1130 /* This allows quits. Also, don't wait forever. */
1131 secs
= x_selection_timeout
/ 1000;
1132 usecs
= (x_selection_timeout
% 1000) * 1000;
1133 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1136 x_check_errors (display
, "Cannot get selection: %s");
1137 x_uncatch_errors (display
);
1138 unbind_to (count
, Qnil
);
1141 if (NILP (XCONS (reading_selection_reply
)->car
))
1142 error ("Timed out waiting for reply from selection owner");
1143 if (EQ (XCONS (reading_selection_reply
)->car
, Qlambda
))
1144 error ("No `%s' selection", XSYMBOL (selection_symbol
)->name
->data
);
1146 /* Otherwise, the selection is waiting for us on the requested property. */
1148 x_get_window_property_as_lisp_data (display
, requestor_window
,
1149 target_property
, target_type
,
1153 /* Subroutines of x_get_window_property_as_lisp_data */
1156 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1157 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1162 unsigned char **data_ret
;
1164 Atom
*actual_type_ret
;
1165 int *actual_format_ret
;
1166 unsigned long *actual_size_ret
;
1170 unsigned long bytes_remaining
;
1172 unsigned char *tmp_data
= 0;
1174 int buffer_size
= SELECTION_QUANTUM (display
);
1175 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1178 /* First probe the thing to find out how big it is. */
1179 result
= XGetWindowProperty (display
, window
, property
,
1180 0L, 0L, False
, AnyPropertyType
,
1181 actual_type_ret
, actual_format_ret
,
1183 &bytes_remaining
, &tmp_data
);
1184 if (result
!= Success
)
1191 xfree ((char *) tmp_data
);
1193 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1199 total_size
= bytes_remaining
+ 1;
1200 *data_ret
= (unsigned char *) xmalloc (total_size
);
1202 /* Now read, until we've gotten it all. */
1203 while (bytes_remaining
)
1206 int last
= bytes_remaining
;
1209 = XGetWindowProperty (display
, window
, property
,
1210 (long)offset
/4, (long)buffer_size
/4,
1213 actual_type_ret
, actual_format_ret
,
1214 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1216 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1218 /* If this doesn't return Success at this point, it means that
1219 some clod deleted the selection while we were in the midst of
1220 reading it. Deal with that, I guess....
1222 if (result
!= Success
) break;
1223 *actual_size_ret
*= *actual_format_ret
/ 8;
1224 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1225 offset
+= *actual_size_ret
;
1226 xfree ((char *) tmp_data
);
1231 *bytes_ret
= offset
;
1235 receive_incremental_selection (display
, window
, property
, target_type
,
1236 min_size_bytes
, data_ret
, size_bytes_ret
,
1237 type_ret
, format_ret
, size_ret
)
1241 Lisp_Object target_type
; /* for error messages only */
1242 unsigned int min_size_bytes
;
1243 unsigned char **data_ret
;
1244 int *size_bytes_ret
;
1246 unsigned long *size_ret
;
1250 struct prop_location
*wait_object
;
1251 *size_bytes_ret
= min_size_bytes
;
1252 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1254 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1257 /* At this point, we have read an INCR property.
1258 Delete the property to ack it.
1259 (But first, prepare to receive the next event in this handshake.)
1261 Now, we must loop, waiting for the sending window to put a value on
1262 that property, then reading the property, then deleting it to ack.
1263 We are done when the sender places a property of length 0.
1266 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1267 XDeleteProperty (display
, window
, property
);
1268 wait_object
= expect_property_change (display
, window
, property
,
1275 unsigned char *tmp_data
;
1277 wait_for_property_change (wait_object
);
1278 /* expect it again immediately, because x_get_window_property may
1279 .. no it won't, I don't get it.
1280 .. Ok, I get it now, the Xt code that implements INCR is broken.
1282 x_get_window_property (display
, window
, property
,
1283 &tmp_data
, &tmp_size_bytes
,
1284 type_ret
, format_ret
, size_ret
, 1);
1286 if (tmp_size_bytes
== 0) /* we're done */
1289 fprintf (stderr
, " read INCR done\n");
1291 if (! waiting_for_other_props_on_window (display
, window
))
1292 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1293 unexpect_property_change (wait_object
);
1294 if (tmp_data
) xfree (tmp_data
);
1299 XDeleteProperty (display
, window
, property
);
1300 wait_object
= expect_property_change (display
, window
, property
,
1306 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1308 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1311 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1312 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1314 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1315 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1317 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1318 offset
+= tmp_size_bytes
;
1323 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1324 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1325 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1328 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1333 Lisp_Object target_type
; /* for error messages only */
1334 Atom selection_atom
; /* for error messages only */
1338 unsigned long actual_size
;
1339 unsigned char *data
= 0;
1342 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1344 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1345 &actual_type
, &actual_format
, &actual_size
, 1);
1348 int there_is_a_selection_owner
;
1350 there_is_a_selection_owner
1351 = XGetSelectionOwner (display
, selection_atom
);
1353 while (1) /* Note debugger can no longer return, so this is obsolete */
1355 there_is_a_selection_owner
?
1356 Fcons (build_string ("selection owner couldn't convert"),
1358 ? Fcons (target_type
,
1359 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1362 : Fcons (target_type
, Qnil
))
1363 : Fcons (build_string ("no selection"),
1364 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1369 if (actual_type
== dpyinfo
->Xatom_INCR
)
1371 /* That wasn't really the data, just the beginning. */
1373 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1375 XFree ((char *) data
);
1377 receive_incremental_selection (display
, window
, property
, target_type
,
1378 min_size_bytes
, &data
, &bytes
,
1379 &actual_type
, &actual_format
,
1384 XDeleteProperty (display
, window
, property
);
1388 /* It's been read. Now convert it to a lisp object in some semi-rational
1390 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1391 actual_type
, actual_format
);
1393 xfree ((char *) data
);
1397 /* These functions convert from the selection data read from the server into
1398 something that we can use from Lisp, and vice versa.
1400 Type: Format: Size: Lisp Type:
1401 ----- ------- ----- -----------
1404 ATOM 32 > 1 Vector of Symbols
1406 * 16 > 1 Vector of Integers
1407 * 32 1 if <=16 bits: Integer
1408 if > 16 bits: Cons of top16, bot16
1409 * 32 > 1 Vector of the above
1411 When converting a Lisp number to C, it is assumed to be of format 16 if
1412 it is an integer, and of format 32 if it is a cons of two integers.
1414 When converting a vector of numbers from Lisp to C, it is assumed to be
1415 of format 16 if every element in the vector is an integer, and is assumed
1416 to be of format 32 if any element is a cons of two integers.
1418 When converting an object to C, it may be of the form (SYMBOL . <data>)
1419 where SYMBOL is what we should claim that the type is. Format and
1420 representation are as above. */
1425 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1427 unsigned char *data
;
1431 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1433 if (type
== dpyinfo
->Xatom_NULL
)
1436 /* Convert any 8-bit data to a string, for compactness. */
1437 else if (format
== 8)
1438 return make_string ((char *) data
, size
);
1440 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1441 a vector of symbols.
1443 else if (type
== XA_ATOM
)
1446 if (size
== sizeof (Atom
))
1447 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1450 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1451 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1452 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1453 ((Atom
*) data
) [i
]));
1458 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1459 If the number is > 16 bits, convert it to a cons of integers,
1460 16 bits in each half.
1462 else if (format
== 32 && size
== sizeof (long))
1463 return long_to_cons (((unsigned long *) data
) [0]);
1464 else if (format
== 16 && size
== sizeof (short))
1465 return make_number ((int) (((unsigned short *) data
) [0]));
1467 /* Convert any other kind of data to a vector of numbers, represented
1468 as above (as an integer, or a cons of two 16 bit integers.)
1470 else if (format
== 16)
1473 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1474 for (i
= 0; i
< size
/ 4; i
++)
1476 int j
= (int) ((unsigned short *) data
) [i
];
1477 Faset (v
, i
, make_number (j
));
1484 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1485 for (i
= 0; i
< size
/ 4; i
++)
1487 unsigned long j
= ((unsigned long *) data
) [i
];
1488 Faset (v
, i
, long_to_cons (j
));
1496 lisp_data_to_selection_data (display
, obj
,
1497 data_ret
, type_ret
, size_ret
,
1498 format_ret
, nofree_ret
)
1501 unsigned char **data_ret
;
1503 unsigned int *size_ret
;
1507 Lisp_Object type
= Qnil
;
1508 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1512 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1514 type
= XCONS (obj
)->car
;
1515 obj
= XCONS (obj
)->cdr
;
1516 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1517 obj
= XCONS (obj
)->car
;
1520 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1521 { /* This is not the same as declining */
1527 else if (STRINGP (obj
))
1530 *size_ret
= XSTRING (obj
)->size
;
1531 *data_ret
= XSTRING (obj
)->data
;
1533 if (NILP (type
)) type
= QSTRING
;
1535 else if (SYMBOLP (obj
))
1539 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1540 (*data_ret
) [sizeof (Atom
)] = 0;
1541 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1542 if (NILP (type
)) type
= QATOM
;
1544 else if (INTEGERP (obj
)
1545 && XINT (obj
) < 0xFFFF
1546 && XINT (obj
) > -0xFFFF)
1550 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1551 (*data_ret
) [sizeof (short)] = 0;
1552 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1553 if (NILP (type
)) type
= QINTEGER
;
1555 else if (INTEGERP (obj
)
1556 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1557 && (INTEGERP (XCONS (obj
)->cdr
)
1558 || (CONSP (XCONS (obj
)->cdr
)
1559 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1563 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1564 (*data_ret
) [sizeof (long)] = 0;
1565 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1566 if (NILP (type
)) type
= QINTEGER
;
1568 else if (VECTORP (obj
))
1570 /* Lisp_Vectors may represent a set of ATOMs;
1571 a set of 16 or 32 bit INTEGERs;
1572 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1576 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1577 /* This vector is an ATOM set */
1579 if (NILP (type
)) type
= QATOM
;
1580 *size_ret
= XVECTOR (obj
)->size
;
1582 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1583 for (i
= 0; i
< *size_ret
; i
++)
1584 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1585 (*(Atom
**) data_ret
) [i
]
1586 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1588 Fsignal (Qerror
, /* Qselection_error */
1590 ("all elements of selection vector must have same type"),
1591 Fcons (obj
, Qnil
)));
1593 #if 0 /* #### MULTIPLE doesn't work yet */
1594 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1595 /* This vector is an ATOM_PAIR set */
1597 if (NILP (type
)) type
= QATOM_PAIR
;
1598 *size_ret
= XVECTOR (obj
)->size
;
1600 *data_ret
= (unsigned char *)
1601 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1602 for (i
= 0; i
< *size_ret
; i
++)
1603 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1605 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1606 if (XVECTOR (pair
)->size
!= 2)
1609 ("elements of the vector must be vectors of exactly two elements"),
1610 Fcons (pair
, Qnil
)));
1612 (*(Atom
**) data_ret
) [i
* 2]
1613 = symbol_to_x_atom (dpyinfo
, display
,
1614 XVECTOR (pair
)->contents
[0]);
1615 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1616 = symbol_to_x_atom (dpyinfo
, display
,
1617 XVECTOR (pair
)->contents
[1]);
1622 ("all elements of the vector must be of the same type"),
1623 Fcons (obj
, Qnil
)));
1628 /* This vector is an INTEGER set, or something like it */
1630 *size_ret
= XVECTOR (obj
)->size
;
1631 if (NILP (type
)) type
= QINTEGER
;
1633 for (i
= 0; i
< *size_ret
; i
++)
1634 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1636 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1637 Fsignal (Qerror
, /* Qselection_error */
1639 ("elements of selection vector must be integers or conses of integers"),
1640 Fcons (obj
, Qnil
)));
1642 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1643 for (i
= 0; i
< *size_ret
; i
++)
1644 if (*format_ret
== 32)
1645 (*((unsigned long **) data_ret
)) [i
]
1646 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1648 (*((unsigned short **) data_ret
)) [i
]
1649 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1653 Fsignal (Qerror
, /* Qselection_error */
1654 Fcons (build_string ("unrecognised selection data"),
1655 Fcons (obj
, Qnil
)));
1657 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1661 clean_local_selection_data (obj
)
1665 && INTEGERP (XCONS (obj
)->car
)
1666 && CONSP (XCONS (obj
)->cdr
)
1667 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1668 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1669 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1672 && INTEGERP (XCONS (obj
)->car
)
1673 && INTEGERP (XCONS (obj
)->cdr
))
1675 if (XINT (XCONS (obj
)->car
) == 0)
1676 return XCONS (obj
)->cdr
;
1677 if (XINT (XCONS (obj
)->car
) == -1)
1678 return make_number (- XINT (XCONS (obj
)->cdr
));
1683 int size
= XVECTOR (obj
)->size
;
1686 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1687 copy
= Fmake_vector (size
, Qnil
);
1688 for (i
= 0; i
< size
; i
++)
1689 XVECTOR (copy
)->contents
[i
]
1690 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1696 /* Called from XTread_socket to handle SelectionNotify events.
1697 If it's the selection we are waiting for, stop waiting
1698 by setting the car of reading_selection_reply to non-nil.
1699 We store t there if the reply is successful, lambda if not. */
1702 x_handle_selection_notify (event
)
1703 XSelectionEvent
*event
;
1705 if (event
->requestor
!= reading_selection_window
)
1707 if (event
->selection
!= reading_which_selection
)
1710 XCONS (reading_selection_reply
)->car
1711 = (event
->property
!= 0 ? Qt
: Qlambda
);
1715 DEFUN ("x-own-selection-internal",
1716 Fx_own_selection_internal
, Sx_own_selection_internal
,
1718 "Assert an X selection of the given TYPE with the given VALUE.\n\
1719 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1720 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1721 VALUE is typically a string, or a cons of two markers, but may be\n\
1722 anything that the functions on `selection-converter-alist' know about.")
1723 (selection_name
, selection_value
)
1724 Lisp_Object selection_name
, selection_value
;
1727 CHECK_SYMBOL (selection_name
, 0);
1728 if (NILP (selection_value
)) error ("selection-value may not be nil");
1729 x_own_selection (selection_name
, selection_value
);
1730 return selection_value
;
1734 /* Request the selection value from the owner. If we are the owner,
1735 simply return our selection value. If we are not the owner, this
1736 will block until all of the data has arrived. */
1738 DEFUN ("x-get-selection-internal",
1739 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1740 "Return text selected from some X window.\n\
1741 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1742 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1743 TYPE is the type of data desired, typically `STRING'.")
1744 (selection_symbol
, target_type
)
1745 Lisp_Object selection_symbol
, target_type
;
1747 Lisp_Object val
= Qnil
;
1748 struct gcpro gcpro1
, gcpro2
;
1749 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1751 CHECK_SYMBOL (selection_symbol
, 0);
1753 #if 0 /* #### MULTIPLE doesn't work yet */
1754 if (CONSP (target_type
)
1755 && XCONS (target_type
)->car
== QMULTIPLE
)
1757 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1758 /* So we don't destructively modify this... */
1759 target_type
= copy_multiple_data (target_type
);
1763 CHECK_SYMBOL (target_type
, 0);
1765 val
= x_get_local_selection (selection_symbol
, target_type
);
1769 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1774 && SYMBOLP (XCONS (val
)->car
))
1776 val
= XCONS (val
)->cdr
;
1777 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1778 val
= XCONS (val
)->car
;
1780 val
= clean_local_selection_data (val
);
1786 DEFUN ("x-disown-selection-internal",
1787 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1788 "If we own the selection SELECTION, disown it.\n\
1789 Disowning it means there is no such selection.")
1791 Lisp_Object selection
;
1795 Atom selection_atom
;
1796 XSelectionClearEvent event
;
1798 struct x_display_info
*dpyinfo
;
1801 display
= FRAME_X_DISPLAY (selected_frame
);
1802 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1803 CHECK_SYMBOL (selection
, 0);
1805 timestamp
= last_event_timestamp
;
1807 timestamp
= cons_to_long (time
);
1809 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1810 return Qnil
; /* Don't disown the selection when we're not the owner. */
1812 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1815 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1818 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1819 generated for a window which owns the selection when that window sets
1820 the selection owner to None. The NCD server does, the MIT Sun4 server
1821 doesn't. So we synthesize one; this means we might get two, but
1822 that's ok, because the second one won't have any effect. */
1823 SELECTION_EVENT_DISPLAY (&event
) = display
;
1824 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1825 SELECTION_EVENT_TIME (&event
) = timestamp
;
1826 x_handle_selection_clear (&event
);
1831 /* Get rid of all the selections in buffer BUFFER.
1832 This is used when we kill a buffer. */
1835 x_disown_buffer_selections (buffer
)
1839 struct buffer
*buf
= XBUFFER (buffer
);
1841 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1843 Lisp_Object elt
, value
;
1844 elt
= XCONS (tail
)->car
;
1845 value
= XCONS (elt
)->cdr
;
1846 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1847 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1848 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1852 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1854 "Whether the current Emacs process owns the given X Selection.\n\
1855 The arg should be the name of the selection in question, typically one of\n\
1856 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1857 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1858 For convenience, the symbol nil is the same as `PRIMARY',\n\
1859 and t is the same as `SECONDARY'.)")
1861 Lisp_Object selection
;
1864 CHECK_SYMBOL (selection
, 0);
1865 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1866 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1868 if (NILP (Fassq (selection
, Vselection_alist
)))
1873 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1875 "Whether there is an owner for the given X Selection.\n\
1876 The arg should be the name of the selection in question, typically one of\n\
1877 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1878 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1879 For convenience, the symbol nil is the same as `PRIMARY',\n\
1880 and t is the same as `SECONDARY'.)")
1882 Lisp_Object selection
;
1888 /* It should be safe to call this before we have an X frame. */
1889 if (! FRAME_X_P (selected_frame
))
1892 dpy
= FRAME_X_DISPLAY (selected_frame
);
1893 CHECK_SYMBOL (selection
, 0);
1894 if (!NILP (Fx_selection_owner_p (selection
)))
1896 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1897 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1898 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1903 owner
= XGetSelectionOwner (dpy
, atom
);
1905 return (owner
? Qt
: Qnil
);
1909 #ifdef CUT_BUFFER_SUPPORT
1911 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1913 initialize_cut_buffers (display
, window
)
1917 unsigned char *data
= (unsigned char *) "";
1919 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1920 PropModeAppend, data, 0)
1921 FROB (XA_CUT_BUFFER0
);
1922 FROB (XA_CUT_BUFFER1
);
1923 FROB (XA_CUT_BUFFER2
);
1924 FROB (XA_CUT_BUFFER3
);
1925 FROB (XA_CUT_BUFFER4
);
1926 FROB (XA_CUT_BUFFER5
);
1927 FROB (XA_CUT_BUFFER6
);
1928 FROB (XA_CUT_BUFFER7
);
1934 #define CHECK_CUT_BUFFER(symbol,n) \
1935 { CHECK_SYMBOL ((symbol), (n)); \
1936 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1937 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1938 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1939 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1941 Fcons (build_string ("doesn't name a cut buffer"), \
1942 Fcons ((symbol), Qnil))); \
1945 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1946 Sx_get_cut_buffer_internal
, 1, 1, 0,
1947 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1953 unsigned char *data
;
1960 struct x_display_info
*dpyinfo
;
1963 display
= FRAME_X_DISPLAY (selected_frame
);
1964 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1965 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1966 CHECK_CUT_BUFFER (buffer
, 0);
1967 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1969 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1970 &type
, &format
, &size
, 0);
1971 if (!data
) return Qnil
;
1973 if (format
!= 8 || type
!= XA_STRING
)
1975 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1976 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
1977 Fcons (make_number (format
), Qnil
))));
1979 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1985 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
1986 Sx_store_cut_buffer_internal
, 2, 2, 0,
1987 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1989 Lisp_Object buffer
, string
;
1993 unsigned char *data
;
1995 int bytes_remaining
;
2000 display
= FRAME_X_DISPLAY (selected_frame
);
2001 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2003 max_bytes
= SELECTION_QUANTUM (display
);
2004 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2005 max_bytes
= MAX_SELECTION_QUANTUM
;
2007 CHECK_CUT_BUFFER (buffer
, 0);
2008 CHECK_STRING (string
, 0);
2009 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
2011 data
= (unsigned char *) XSTRING (string
)->data
;
2012 bytes
= XSTRING (string
)->size
;
2013 bytes_remaining
= bytes
;
2015 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2017 initialize_cut_buffers (display
, window
);
2018 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2023 /* Don't mess up with an empty value. */
2024 if (!bytes_remaining
)
2025 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2026 PropModeReplace
, data
, 0);
2028 while (bytes_remaining
)
2030 int chunk
= (bytes_remaining
< max_bytes
2031 ? bytes_remaining
: max_bytes
);
2032 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2033 (bytes_remaining
== bytes
2038 bytes_remaining
-= chunk
;
2045 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2046 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2047 "Rotate the values of the cut buffers by the given number of steps;\n\
2048 positive means move values forward, negative means backward.")
2057 display
= FRAME_X_DISPLAY (selected_frame
);
2058 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2059 CHECK_NUMBER (n
, 0);
2062 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2064 initialize_cut_buffers (display
, window
);
2065 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2068 props
[0] = XA_CUT_BUFFER0
;
2069 props
[1] = XA_CUT_BUFFER1
;
2070 props
[2] = XA_CUT_BUFFER2
;
2071 props
[3] = XA_CUT_BUFFER3
;
2072 props
[4] = XA_CUT_BUFFER4
;
2073 props
[5] = XA_CUT_BUFFER5
;
2074 props
[6] = XA_CUT_BUFFER6
;
2075 props
[7] = XA_CUT_BUFFER7
;
2077 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2087 defsubr (&Sx_get_selection_internal
);
2088 defsubr (&Sx_own_selection_internal
);
2089 defsubr (&Sx_disown_selection_internal
);
2090 defsubr (&Sx_selection_owner_p
);
2091 defsubr (&Sx_selection_exists_p
);
2093 #ifdef CUT_BUFFER_SUPPORT
2094 defsubr (&Sx_get_cut_buffer_internal
);
2095 defsubr (&Sx_store_cut_buffer_internal
);
2096 defsubr (&Sx_rotate_cut_buffers_internal
);
2099 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2100 staticpro (&reading_selection_reply
);
2101 reading_selection_window
= 0;
2102 reading_which_selection
= 0;
2104 property_change_wait_list
= 0;
2105 prop_location_identifier
= 0;
2106 property_change_reply
= Fcons (Qnil
, Qnil
);
2107 staticpro (&property_change_reply
);
2109 Vselection_alist
= Qnil
;
2110 staticpro (&Vselection_alist
);
2112 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2113 "An alist associating X Windows selection-types with functions.\n\
2114 These functions are called to convert the selection, with three args:\n\
2115 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2116 a desired type to which the selection should be converted;\n\
2117 and the local selection value (whatever was given to `x-own-selection').\n\
2119 The function should return the value to send to the X server\n\
2120 \(typically a string). A return value of nil\n\
2121 means that the conversion could not be done.\n\
2122 A return value which is the symbol `NULL'\n\
2123 means that a side-effect was executed,\n\
2124 and there is no meaningful selection value.");
2125 Vselection_converter_alist
= Qnil
;
2127 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2128 "A list of functions to be called when Emacs loses an X selection.\n\
2129 \(This happens when some other X client makes its own selection\n\
2130 or when a Lisp program explicitly clears the selection.)\n\
2131 The functions are called with one argument, the selection type\n\
2132 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2133 Vx_lost_selection_hooks
= Qnil
;
2135 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2136 "A list of functions to be called when Emacs answers a selection request.\n\
2137 The functions are called with four arguments:\n\
2138 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2139 - the selection-type which Emacs was asked to convert the\n\
2140 selection into before sending (for example, `STRING' or `LENGTH');\n\
2141 - a flag indicating success or failure for responding to the request.\n\
2142 We might have failed (and declined the request) for any number of reasons,\n\
2143 including being asked for a selection that we no longer own, or being asked\n\
2144 to convert into a type that we don't know about or that is inappropriate.\n\
2145 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2146 it merely informs you that they have happened.");
2147 Vx_sent_selection_hooks
= Qnil
;
2149 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2150 "Number of milliseconds to wait for a selection reply.\n\
2151 If the selection owner doesn't reply in this time, we give up.\n\
2152 A value of 0 means wait as long as necessary. This is initialized from the\n\
2153 \"*selectionTimeout\" resource.");
2154 x_selection_timeout
= 0;
2156 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2157 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2158 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2159 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2160 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2161 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2162 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2163 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2164 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2165 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2166 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2167 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2168 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2169 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2170 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2171 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2173 #ifdef CUT_BUFFER_SUPPORT
2174 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2175 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2176 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2177 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2178 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2179 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2180 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2181 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);