1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996 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"
31 #define CUT_BUFFER_SUPPORT
33 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
34 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
37 #ifdef CUT_BUFFER_SUPPORT
38 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
39 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
42 static Lisp_Object Vx_lost_selection_hooks
;
43 static Lisp_Object Vx_sent_selection_hooks
;
45 /* If this is a smaller number than the max-request-size of the display,
46 emacs will use INCR selection transfer when the selection is larger
47 than this. The max-request-size is usually around 64k, so if you want
48 emacs to use incremental selection transfers when the selection is
49 smaller than that, set this. I added this mostly for debugging the
50 incremental transfer stuff, but it might improve server performance. */
51 #define MAX_SELECTION_QUANTUM 0xFFFFFF
54 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
56 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
59 /* The timestamp of the last input event Emacs received from the X server. */
60 /* Defined in keyboard.c. */
61 extern unsigned long last_event_timestamp
;
63 /* This is an association list whose elements are of the form
64 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
65 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
66 SELECTION-VALUE is the value that emacs owns for that selection.
67 It may be any kind of Lisp object.
68 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
69 as a cons of two 16-bit numbers (making a 32 bit time.)
70 FRAME is the frame for which we made the selection.
71 If there is an entry in this alist, then it can be assumed that Emacs owns
73 The only (eq) parts of this list that are visible from Lisp are the
75 static Lisp_Object Vselection_alist
;
77 /* This is an alist whose CARs are selection-types (whose names are the same
78 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
79 call to convert the given Emacs selection value to a string representing
80 the given selection type. This is for Lisp-level extension of the emacs
81 selection handling. */
82 static Lisp_Object Vselection_converter_alist
;
84 /* If the selection owner takes too long to reply to a selection request,
85 we give up on it. This is in milliseconds (0 = no timeout.) */
86 static int x_selection_timeout
;
88 /* Utility functions */
90 static void lisp_data_to_selection_data ();
91 static Lisp_Object
selection_data_to_lisp_data ();
92 static Lisp_Object
x_get_window_property_as_lisp_data ();
94 /* This converts a Lisp symbol to a server Atom, avoiding a server
95 roundtrip whenever possible. */
98 symbol_to_x_atom (dpyinfo
, display
, sym
)
99 struct x_display_info
*dpyinfo
;
104 if (NILP (sym
)) return 0;
105 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
106 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
107 if (EQ (sym
, QSTRING
)) return XA_STRING
;
108 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
109 if (EQ (sym
, QATOM
)) return XA_ATOM
;
110 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
111 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
112 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
113 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
114 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
115 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
116 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
117 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
118 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
119 #ifdef CUT_BUFFER_SUPPORT
120 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
121 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
122 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
123 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
124 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
125 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
126 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
127 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
129 if (!SYMBOLP (sym
)) abort ();
132 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
135 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
141 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
142 and calls to intern whenever possible. */
145 x_atom_to_symbol (dpyinfo
, display
, atom
)
146 struct x_display_info
*dpyinfo
;
152 if (! atom
) return Qnil
;
165 #ifdef CUT_BUFFER_SUPPORT
185 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
187 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
189 if (atom
== dpyinfo
->Xatom_TEXT
)
191 if (atom
== dpyinfo
->Xatom_DELETE
)
193 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
195 if (atom
== dpyinfo
->Xatom_INCR
)
197 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
199 if (atom
== dpyinfo
->Xatom_TARGETS
)
201 if (atom
== dpyinfo
->Xatom_NULL
)
205 str
= XGetAtomName (display
, atom
);
208 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
210 if (! str
) return Qnil
;
213 /* This was allocated by Xlib, so use XFree. */
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;
723 /* Use free, not XFree, because lisp_data_to_selection_data
724 calls xmalloc itself. */
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 /* Delete elements from the beginning of Vselection_alist. */
825 while (!NILP (Vselection_alist
)
826 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
828 /* Let random Lisp code notice that the selection has been stolen. */
829 Lisp_Object hooks
, selection_symbol
;
831 hooks
= Vx_lost_selection_hooks
;
832 selection_symbol
= Fcar (Fcar (Vselection_alist
));
834 if (!EQ (hooks
, Qunbound
))
836 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
837 call1 (Fcar (hooks
), selection_symbol
);
838 #if 0 /* This can crash when deleting a frame
839 from x_connection_closed. Anyway, it seems unnecessary;
840 something else should cause a redisplay. */
841 redisplay_preserve_echo_area ();
845 Vselection_alist
= Fcdr (Vselection_alist
);
848 /* Delete elements after the beginning of Vselection_alist. */
849 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
850 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest
)->cdr
)))))))
852 /* Let random Lisp code notice that the selection has been stolen. */
853 Lisp_Object hooks
, selection_symbol
;
855 hooks
= Vx_lost_selection_hooks
;
856 selection_symbol
= Fcar (Fcar (XCONS (rest
)->cdr
));
858 if (!EQ (hooks
, Qunbound
))
860 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
861 call1 (Fcar (hooks
), selection_symbol
);
862 #if 0 /* See above */
863 redisplay_preserve_echo_area ();
866 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
871 /* Nonzero if any properties for DISPLAY and WINDOW
872 are on the list of what we are waiting for. */
875 waiting_for_other_props_on_window (display
, window
)
879 struct prop_location
*rest
= property_change_wait_list
;
881 if (rest
->display
== display
&& rest
->window
== window
)
888 /* Add an entry to the list of property changes we are waiting for.
889 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
890 The return value is a number that uniquely identifies
891 this awaited property change. */
893 static struct prop_location
*
894 expect_property_change (display
, window
, property
, state
)
897 Lisp_Object property
;
900 struct prop_location
*pl
901 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
902 pl
->identifier
= ++prop_location_identifier
;
903 pl
->display
= display
;
905 pl
->property
= property
;
906 pl
->desired_state
= state
;
907 pl
->next
= property_change_wait_list
;
909 property_change_wait_list
= pl
;
913 /* Delete an entry from the list of property changes we are waiting for.
914 IDENTIFIER is the number that uniquely identifies the entry. */
917 unexpect_property_change (location
)
918 struct prop_location
*location
;
920 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
923 if (rest
== location
)
926 prev
->next
= rest
->next
;
928 property_change_wait_list
= rest
->next
;
937 /* Remove the property change expectation element for IDENTIFIER. */
940 wait_for_property_change_unwind (identifierval
)
941 Lisp_Object identifierval
;
943 unexpect_property_change ((struct prop_location
*)
944 (XFASTINT (XCONS (identifierval
)->car
) << 16
945 | XFASTINT (XCONS (identifierval
)->cdr
)));
949 /* Actually wait for a property change.
950 IDENTIFIER should be the value that expect_property_change returned. */
953 wait_for_property_change (location
)
954 struct prop_location
*location
;
957 int count
= specpdl_ptr
- specpdl
;
960 tem
= Fcons (Qnil
, Qnil
);
961 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
962 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
964 /* Make sure to do unexpect_property_change if we quit or err. */
965 record_unwind_protect (wait_for_property_change_unwind
, tem
);
967 XCONS (property_change_reply
)->car
= Qnil
;
969 property_change_reply_object
= location
;
970 /* If the event we are waiting for arrives beyond here, it will set
971 property_change_reply, because property_change_reply_object says so. */
972 if (! location
->arrived
)
974 secs
= x_selection_timeout
/ 1000;
975 usecs
= (x_selection_timeout
% 1000) * 1000;
976 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
978 if (NILP (XCONS (property_change_reply
)->car
))
979 error ("Timed out waiting for property-notify event");
982 unbind_to (count
, Qnil
);
985 /* Called from XTread_socket in response to a PropertyNotify event. */
988 x_handle_property_notify (event
)
989 XPropertyEvent
*event
;
991 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
994 if (rest
->property
== event
->atom
995 && rest
->window
== event
->window
996 && rest
->display
== event
->display
997 && rest
->desired_state
== event
->state
)
1000 fprintf (stderr
, "Saw expected prop-%s on %s\n",
1001 (event
->state
== PropertyDelete
? "delete" : "change"),
1002 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
1009 /* If this is the one wait_for_property_change is waiting for,
1010 tell it to wake up. */
1011 if (rest
== property_change_reply_object
)
1012 XCONS (property_change_reply
)->car
= Qt
;
1015 prev
->next
= rest
->next
;
1017 property_change_wait_list
= rest
->next
;
1025 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
1026 (event
->state
== PropertyDelete
? "delete" : "change"),
1027 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
1028 event
->display
, event
->atom
))
1035 #if 0 /* #### MULTIPLE doesn't work yet */
1038 fetch_multiple_target (event
)
1039 XSelectionRequestEvent
*event
;
1041 Display
*display
= event
->display
;
1042 Window window
= event
->requestor
;
1043 Atom target
= event
->target
;
1044 Atom selection_atom
= event
->selection
;
1049 x_get_window_property_as_lisp_data (display
, window
, target
,
1050 QMULTIPLE
, selection_atom
));
1054 copy_multiple_data (obj
)
1061 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1063 CHECK_VECTOR (obj
, 0);
1064 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1065 for (i
= 0; i
< size
; i
++)
1067 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1068 CHECK_VECTOR (vec2
, 0);
1069 if (XVECTOR (vec2
)->size
!= 2)
1070 /* ??? Confusing error message */
1071 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1072 Fcons (vec2
, Qnil
)));
1073 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1074 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1075 = XVECTOR (vec2
)->contents
[0];
1076 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1077 = XVECTOR (vec2
)->contents
[1];
1085 /* Variables for communication with x_handle_selection_notify. */
1086 static Atom reading_which_selection
;
1087 static Lisp_Object reading_selection_reply
;
1088 static Window reading_selection_window
;
1090 /* Do protocol to read selection-data from the server.
1091 Converts this to Lisp data and returns it. */
1094 x_get_foreign_selection (selection_symbol
, target_type
)
1095 Lisp_Object selection_symbol
, target_type
;
1097 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1098 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1099 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1100 Time requestor_time
= last_event_timestamp
;
1101 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1102 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1105 int count
= specpdl_ptr
- specpdl
;
1108 if (CONSP (target_type
))
1109 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1111 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1114 x_catch_errors (display
);
1115 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1116 requestor_window
, requestor_time
);
1119 /* Prepare to block until the reply has been read. */
1120 reading_selection_window
= requestor_window
;
1121 reading_which_selection
= selection_atom
;
1122 XCONS (reading_selection_reply
)->car
= Qnil
;
1124 frame
= some_frame_on_display (dpyinfo
);
1126 /* If the display no longer has frames, we can't expect
1127 to get many more selection requests from it, so don't
1128 bother trying to queue them. */
1131 x_start_queuing_selection_requests (display
);
1133 record_unwind_protect (queue_selection_requests_unwind
,
1138 /* This allows quits. Also, don't wait forever. */
1139 secs
= x_selection_timeout
/ 1000;
1140 usecs
= (x_selection_timeout
% 1000) * 1000;
1141 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1144 x_check_errors (display
, "Cannot get selection: %s");
1145 x_uncatch_errors (display
);
1146 unbind_to (count
, Qnil
);
1149 if (NILP (XCONS (reading_selection_reply
)->car
))
1150 error ("Timed out waiting for reply from selection owner");
1151 if (EQ (XCONS (reading_selection_reply
)->car
, Qlambda
))
1152 error ("No `%s' selection", XSYMBOL (selection_symbol
)->name
->data
);
1154 /* Otherwise, the selection is waiting for us on the requested property. */
1156 x_get_window_property_as_lisp_data (display
, requestor_window
,
1157 target_property
, target_type
,
1161 /* Subroutines of x_get_window_property_as_lisp_data */
1163 /* Use free, not XFree, to free the data obtained with this function. */
1166 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1167 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1172 unsigned char **data_ret
;
1174 Atom
*actual_type_ret
;
1175 int *actual_format_ret
;
1176 unsigned long *actual_size_ret
;
1180 unsigned long bytes_remaining
;
1182 unsigned char *tmp_data
= 0;
1184 int buffer_size
= SELECTION_QUANTUM (display
);
1185 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1188 /* First probe the thing to find out how big it is. */
1189 result
= XGetWindowProperty (display
, window
, property
,
1190 0L, 0L, False
, AnyPropertyType
,
1191 actual_type_ret
, actual_format_ret
,
1193 &bytes_remaining
, &tmp_data
);
1194 if (result
!= Success
)
1201 /* This was allocated by Xlib, so use XFree. */
1202 XFree ((char *) tmp_data
);
1204 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1210 total_size
= bytes_remaining
+ 1;
1211 *data_ret
= (unsigned char *) xmalloc (total_size
);
1213 /* Now read, until we've gotten it all. */
1214 while (bytes_remaining
)
1217 int last
= bytes_remaining
;
1220 = XGetWindowProperty (display
, window
, property
,
1221 (long)offset
/4, (long)buffer_size
/4,
1224 actual_type_ret
, actual_format_ret
,
1225 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1227 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1229 /* If this doesn't return Success at this point, it means that
1230 some clod deleted the selection while we were in the midst of
1231 reading it. Deal with that, I guess....
1233 if (result
!= Success
) break;
1234 *actual_size_ret
*= *actual_format_ret
/ 8;
1235 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1236 offset
+= *actual_size_ret
;
1237 /* This was allocated by Xlib, so use XFree. */
1238 XFree ((char *) tmp_data
);
1243 *bytes_ret
= offset
;
1246 /* Use free, not XFree, to free the data obtained with this function. */
1249 receive_incremental_selection (display
, window
, property
, target_type
,
1250 min_size_bytes
, data_ret
, size_bytes_ret
,
1251 type_ret
, format_ret
, size_ret
)
1255 Lisp_Object target_type
; /* for error messages only */
1256 unsigned int min_size_bytes
;
1257 unsigned char **data_ret
;
1258 int *size_bytes_ret
;
1260 unsigned long *size_ret
;
1264 struct prop_location
*wait_object
;
1265 *size_bytes_ret
= min_size_bytes
;
1266 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1268 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1271 /* At this point, we have read an INCR property.
1272 Delete the property to ack it.
1273 (But first, prepare to receive the next event in this handshake.)
1275 Now, we must loop, waiting for the sending window to put a value on
1276 that property, then reading the property, then deleting it to ack.
1277 We are done when the sender places a property of length 0.
1280 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1281 XDeleteProperty (display
, window
, property
);
1282 wait_object
= expect_property_change (display
, window
, property
,
1289 unsigned char *tmp_data
;
1291 wait_for_property_change (wait_object
);
1292 /* expect it again immediately, because x_get_window_property may
1293 .. no it won't, I don't get it.
1294 .. Ok, I get it now, the Xt code that implements INCR is broken.
1296 x_get_window_property (display
, window
, property
,
1297 &tmp_data
, &tmp_size_bytes
,
1298 type_ret
, format_ret
, size_ret
, 1);
1300 if (tmp_size_bytes
== 0) /* we're done */
1303 fprintf (stderr
, " read INCR done\n");
1305 if (! waiting_for_other_props_on_window (display
, window
))
1306 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1307 unexpect_property_change (wait_object
);
1308 /* Use free, not XFree, because x_get_window_property
1309 calls xmalloc itself. */
1310 if (tmp_data
) free (tmp_data
);
1315 XDeleteProperty (display
, window
, property
);
1316 wait_object
= expect_property_change (display
, window
, property
,
1322 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1324 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1327 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1328 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1330 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1331 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1333 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1334 offset
+= tmp_size_bytes
;
1335 /* Use free, not XFree, because x_get_window_property
1336 calls xmalloc itself. */
1341 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1342 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1343 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1346 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1351 Lisp_Object target_type
; /* for error messages only */
1352 Atom selection_atom
; /* for error messages only */
1356 unsigned long actual_size
;
1357 unsigned char *data
= 0;
1360 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1362 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1363 &actual_type
, &actual_format
, &actual_size
, 1);
1366 int there_is_a_selection_owner
;
1368 there_is_a_selection_owner
1369 = XGetSelectionOwner (display
, selection_atom
);
1371 while (1) /* Note debugger can no longer return, so this is obsolete */
1373 there_is_a_selection_owner
?
1374 Fcons (build_string ("selection owner couldn't convert"),
1376 ? Fcons (target_type
,
1377 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1380 : Fcons (target_type
, Qnil
))
1381 : Fcons (build_string ("no selection"),
1382 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1387 if (actual_type
== dpyinfo
->Xatom_INCR
)
1389 /* That wasn't really the data, just the beginning. */
1391 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1393 /* Use free, not XFree, because x_get_window_property
1394 calls xmalloc itself. */
1395 free ((char *) data
);
1397 receive_incremental_selection (display
, window
, property
, target_type
,
1398 min_size_bytes
, &data
, &bytes
,
1399 &actual_type
, &actual_format
,
1404 XDeleteProperty (display
, window
, property
);
1408 /* It's been read. Now convert it to a lisp object in some semi-rational
1410 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1411 actual_type
, actual_format
);
1413 /* Use free, not XFree, because x_get_window_property
1414 calls xmalloc itself. */
1415 free ((char *) data
);
1419 /* These functions convert from the selection data read from the server into
1420 something that we can use from Lisp, and vice versa.
1422 Type: Format: Size: Lisp Type:
1423 ----- ------- ----- -----------
1426 ATOM 32 > 1 Vector of Symbols
1428 * 16 > 1 Vector of Integers
1429 * 32 1 if <=16 bits: Integer
1430 if > 16 bits: Cons of top16, bot16
1431 * 32 > 1 Vector of the above
1433 When converting a Lisp number to C, it is assumed to be of format 16 if
1434 it is an integer, and of format 32 if it is a cons of two integers.
1436 When converting a vector of numbers from Lisp to C, it is assumed to be
1437 of format 16 if every element in the vector is an integer, and is assumed
1438 to be of format 32 if any element is a cons of two integers.
1440 When converting an object to C, it may be of the form (SYMBOL . <data>)
1441 where SYMBOL is what we should claim that the type is. Format and
1442 representation are as above. */
1447 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1449 unsigned char *data
;
1453 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1455 if (type
== dpyinfo
->Xatom_NULL
)
1458 /* Convert any 8-bit data to a string, for compactness. */
1459 else if (format
== 8)
1460 return make_string ((char *) data
, size
);
1462 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1463 a vector of symbols.
1465 else if (type
== XA_ATOM
)
1468 if (size
== sizeof (Atom
))
1469 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1472 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1473 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1474 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1475 ((Atom
*) data
) [i
]));
1480 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1481 If the number is > 16 bits, convert it to a cons of integers,
1482 16 bits in each half.
1484 else if (format
== 32 && size
== sizeof (long))
1485 return long_to_cons (((unsigned long *) data
) [0]);
1486 else if (format
== 16 && size
== sizeof (short))
1487 return make_number ((int) (((unsigned short *) data
) [0]));
1489 /* Convert any other kind of data to a vector of numbers, represented
1490 as above (as an integer, or a cons of two 16 bit integers.)
1492 else if (format
== 16)
1495 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1496 for (i
= 0; i
< size
/ 4; i
++)
1498 int j
= (int) ((unsigned short *) data
) [i
];
1499 Faset (v
, i
, make_number (j
));
1506 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1507 for (i
= 0; i
< size
/ 4; i
++)
1509 unsigned long j
= ((unsigned long *) data
) [i
];
1510 Faset (v
, i
, long_to_cons (j
));
1517 /* Use free, not XFree, to free the data obtained with this function. */
1520 lisp_data_to_selection_data (display
, obj
,
1521 data_ret
, type_ret
, size_ret
,
1522 format_ret
, nofree_ret
)
1525 unsigned char **data_ret
;
1527 unsigned int *size_ret
;
1531 Lisp_Object type
= Qnil
;
1532 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1536 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1538 type
= XCONS (obj
)->car
;
1539 obj
= XCONS (obj
)->cdr
;
1540 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1541 obj
= XCONS (obj
)->car
;
1544 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1545 { /* This is not the same as declining */
1551 else if (STRINGP (obj
))
1554 *size_ret
= XSTRING (obj
)->size
;
1555 *data_ret
= XSTRING (obj
)->data
;
1557 if (NILP (type
)) type
= QSTRING
;
1559 else if (SYMBOLP (obj
))
1563 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1564 (*data_ret
) [sizeof (Atom
)] = 0;
1565 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1566 if (NILP (type
)) type
= QATOM
;
1568 else if (INTEGERP (obj
)
1569 && XINT (obj
) < 0xFFFF
1570 && XINT (obj
) > -0xFFFF)
1574 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1575 (*data_ret
) [sizeof (short)] = 0;
1576 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1577 if (NILP (type
)) type
= QINTEGER
;
1579 else if (INTEGERP (obj
)
1580 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1581 && (INTEGERP (XCONS (obj
)->cdr
)
1582 || (CONSP (XCONS (obj
)->cdr
)
1583 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1587 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1588 (*data_ret
) [sizeof (long)] = 0;
1589 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1590 if (NILP (type
)) type
= QINTEGER
;
1592 else if (VECTORP (obj
))
1594 /* Lisp_Vectors may represent a set of ATOMs;
1595 a set of 16 or 32 bit INTEGERs;
1596 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1600 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1601 /* This vector is an ATOM set */
1603 if (NILP (type
)) type
= QATOM
;
1604 *size_ret
= XVECTOR (obj
)->size
;
1606 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1607 for (i
= 0; i
< *size_ret
; i
++)
1608 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1609 (*(Atom
**) data_ret
) [i
]
1610 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1612 Fsignal (Qerror
, /* Qselection_error */
1614 ("all elements of selection vector must have same type"),
1615 Fcons (obj
, Qnil
)));
1617 #if 0 /* #### MULTIPLE doesn't work yet */
1618 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1619 /* This vector is an ATOM_PAIR set */
1621 if (NILP (type
)) type
= QATOM_PAIR
;
1622 *size_ret
= XVECTOR (obj
)->size
;
1624 *data_ret
= (unsigned char *)
1625 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1626 for (i
= 0; i
< *size_ret
; i
++)
1627 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1629 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1630 if (XVECTOR (pair
)->size
!= 2)
1633 ("elements of the vector must be vectors of exactly two elements"),
1634 Fcons (pair
, Qnil
)));
1636 (*(Atom
**) data_ret
) [i
* 2]
1637 = symbol_to_x_atom (dpyinfo
, display
,
1638 XVECTOR (pair
)->contents
[0]);
1639 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1640 = symbol_to_x_atom (dpyinfo
, display
,
1641 XVECTOR (pair
)->contents
[1]);
1646 ("all elements of the vector must be of the same type"),
1647 Fcons (obj
, Qnil
)));
1652 /* This vector is an INTEGER set, or something like it */
1654 *size_ret
= XVECTOR (obj
)->size
;
1655 if (NILP (type
)) type
= QINTEGER
;
1657 for (i
= 0; i
< *size_ret
; i
++)
1658 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1660 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1661 Fsignal (Qerror
, /* Qselection_error */
1663 ("elements of selection vector must be integers or conses of integers"),
1664 Fcons (obj
, Qnil
)));
1666 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1667 for (i
= 0; i
< *size_ret
; i
++)
1668 if (*format_ret
== 32)
1669 (*((unsigned long **) data_ret
)) [i
]
1670 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1672 (*((unsigned short **) data_ret
)) [i
]
1673 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1677 Fsignal (Qerror
, /* Qselection_error */
1678 Fcons (build_string ("unrecognised selection data"),
1679 Fcons (obj
, Qnil
)));
1681 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1685 clean_local_selection_data (obj
)
1689 && INTEGERP (XCONS (obj
)->car
)
1690 && CONSP (XCONS (obj
)->cdr
)
1691 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1692 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1693 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1696 && INTEGERP (XCONS (obj
)->car
)
1697 && INTEGERP (XCONS (obj
)->cdr
))
1699 if (XINT (XCONS (obj
)->car
) == 0)
1700 return XCONS (obj
)->cdr
;
1701 if (XINT (XCONS (obj
)->car
) == -1)
1702 return make_number (- XINT (XCONS (obj
)->cdr
));
1707 int size
= XVECTOR (obj
)->size
;
1710 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1711 copy
= Fmake_vector (size
, Qnil
);
1712 for (i
= 0; i
< size
; i
++)
1713 XVECTOR (copy
)->contents
[i
]
1714 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1720 /* Called from XTread_socket to handle SelectionNotify events.
1721 If it's the selection we are waiting for, stop waiting
1722 by setting the car of reading_selection_reply to non-nil.
1723 We store t there if the reply is successful, lambda if not. */
1726 x_handle_selection_notify (event
)
1727 XSelectionEvent
*event
;
1729 if (event
->requestor
!= reading_selection_window
)
1731 if (event
->selection
!= reading_which_selection
)
1734 XCONS (reading_selection_reply
)->car
1735 = (event
->property
!= 0 ? Qt
: Qlambda
);
1739 DEFUN ("x-own-selection-internal",
1740 Fx_own_selection_internal
, Sx_own_selection_internal
,
1742 "Assert an X selection of the given TYPE with the given VALUE.\n\
1743 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1744 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1745 VALUE is typically a string, or a cons of two markers, but may be\n\
1746 anything that the functions on `selection-converter-alist' know about.")
1747 (selection_name
, selection_value
)
1748 Lisp_Object selection_name
, selection_value
;
1751 CHECK_SYMBOL (selection_name
, 0);
1752 if (NILP (selection_value
)) error ("selection-value may not be nil");
1753 x_own_selection (selection_name
, selection_value
);
1754 return selection_value
;
1758 /* Request the selection value from the owner. If we are the owner,
1759 simply return our selection value. If we are not the owner, this
1760 will block until all of the data has arrived. */
1762 DEFUN ("x-get-selection-internal",
1763 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1764 "Return text selected from some X window.\n\
1765 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1766 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1767 TYPE is the type of data desired, typically `STRING'.")
1768 (selection_symbol
, target_type
)
1769 Lisp_Object selection_symbol
, target_type
;
1771 Lisp_Object val
= Qnil
;
1772 struct gcpro gcpro1
, gcpro2
;
1773 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1775 CHECK_SYMBOL (selection_symbol
, 0);
1777 #if 0 /* #### MULTIPLE doesn't work yet */
1778 if (CONSP (target_type
)
1779 && XCONS (target_type
)->car
== QMULTIPLE
)
1781 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1782 /* So we don't destructively modify this... */
1783 target_type
= copy_multiple_data (target_type
);
1787 CHECK_SYMBOL (target_type
, 0);
1789 val
= x_get_local_selection (selection_symbol
, target_type
);
1793 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1798 && SYMBOLP (XCONS (val
)->car
))
1800 val
= XCONS (val
)->cdr
;
1801 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1802 val
= XCONS (val
)->car
;
1804 val
= clean_local_selection_data (val
);
1810 DEFUN ("x-disown-selection-internal",
1811 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1812 "If we own the selection SELECTION, disown it.\n\
1813 Disowning it means there is no such selection.")
1815 Lisp_Object selection
;
1819 Atom selection_atom
;
1820 XSelectionClearEvent event
;
1822 struct x_display_info
*dpyinfo
;
1825 display
= FRAME_X_DISPLAY (selected_frame
);
1826 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1827 CHECK_SYMBOL (selection
, 0);
1829 timestamp
= last_event_timestamp
;
1831 timestamp
= cons_to_long (time
);
1833 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1834 return Qnil
; /* Don't disown the selection when we're not the owner. */
1836 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1839 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1842 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1843 generated for a window which owns the selection when that window sets
1844 the selection owner to None. The NCD server does, the MIT Sun4 server
1845 doesn't. So we synthesize one; this means we might get two, but
1846 that's ok, because the second one won't have any effect. */
1847 SELECTION_EVENT_DISPLAY (&event
) = display
;
1848 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1849 SELECTION_EVENT_TIME (&event
) = timestamp
;
1850 x_handle_selection_clear (&event
);
1855 /* Get rid of all the selections in buffer BUFFER.
1856 This is used when we kill a buffer. */
1859 x_disown_buffer_selections (buffer
)
1863 struct buffer
*buf
= XBUFFER (buffer
);
1865 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1867 Lisp_Object elt
, value
;
1868 elt
= XCONS (tail
)->car
;
1869 value
= XCONS (elt
)->cdr
;
1870 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1871 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1872 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1876 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1878 "Whether the current Emacs process owns the given X Selection.\n\
1879 The arg should be the name of the selection in question, typically one of\n\
1880 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1881 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1882 For convenience, the symbol nil is the same as `PRIMARY',\n\
1883 and t is the same as `SECONDARY'.)")
1885 Lisp_Object selection
;
1888 CHECK_SYMBOL (selection
, 0);
1889 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1890 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1892 if (NILP (Fassq (selection
, Vselection_alist
)))
1897 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1899 "Whether there is an owner for the given X Selection.\n\
1900 The arg should be the name of the selection in question, typically one of\n\
1901 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1902 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1903 For convenience, the symbol nil is the same as `PRIMARY',\n\
1904 and t is the same as `SECONDARY'.)")
1906 Lisp_Object selection
;
1912 /* It should be safe to call this before we have an X frame. */
1913 if (! FRAME_X_P (selected_frame
))
1916 dpy
= FRAME_X_DISPLAY (selected_frame
);
1917 CHECK_SYMBOL (selection
, 0);
1918 if (!NILP (Fx_selection_owner_p (selection
)))
1920 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1921 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1922 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1927 owner
= XGetSelectionOwner (dpy
, atom
);
1929 return (owner
? Qt
: Qnil
);
1933 #ifdef CUT_BUFFER_SUPPORT
1935 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1937 initialize_cut_buffers (display
, window
)
1941 unsigned char *data
= (unsigned char *) "";
1943 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1944 PropModeAppend, data, 0)
1945 FROB (XA_CUT_BUFFER0
);
1946 FROB (XA_CUT_BUFFER1
);
1947 FROB (XA_CUT_BUFFER2
);
1948 FROB (XA_CUT_BUFFER3
);
1949 FROB (XA_CUT_BUFFER4
);
1950 FROB (XA_CUT_BUFFER5
);
1951 FROB (XA_CUT_BUFFER6
);
1952 FROB (XA_CUT_BUFFER7
);
1958 #define CHECK_CUT_BUFFER(symbol,n) \
1959 { CHECK_SYMBOL ((symbol), (n)); \
1960 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1961 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1962 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1963 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1965 Fcons (build_string ("doesn't name a cut buffer"), \
1966 Fcons ((symbol), Qnil))); \
1969 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1970 Sx_get_cut_buffer_internal
, 1, 1, 0,
1971 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1977 unsigned char *data
;
1984 struct x_display_info
*dpyinfo
;
1987 display
= FRAME_X_DISPLAY (selected_frame
);
1988 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1989 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1990 CHECK_CUT_BUFFER (buffer
, 0);
1991 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1993 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1994 &type
, &format
, &size
, 0);
1995 if (!data
) return Qnil
;
1997 if (format
!= 8 || type
!= XA_STRING
)
1999 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2000 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
2001 Fcons (make_number (format
), Qnil
))));
2003 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2004 /* Use free, not XFree, because x_get_window_property
2005 calls xmalloc itself. */
2011 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2012 Sx_store_cut_buffer_internal
, 2, 2, 0,
2013 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2015 Lisp_Object buffer
, string
;
2019 unsigned char *data
;
2021 int bytes_remaining
;
2026 display
= FRAME_X_DISPLAY (selected_frame
);
2027 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2029 max_bytes
= SELECTION_QUANTUM (display
);
2030 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2031 max_bytes
= MAX_SELECTION_QUANTUM
;
2033 CHECK_CUT_BUFFER (buffer
, 0);
2034 CHECK_STRING (string
, 0);
2035 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
2037 data
= (unsigned char *) XSTRING (string
)->data
;
2038 bytes
= XSTRING (string
)->size
;
2039 bytes_remaining
= bytes
;
2041 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2043 initialize_cut_buffers (display
, window
);
2044 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2049 /* Don't mess up with an empty value. */
2050 if (!bytes_remaining
)
2051 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2052 PropModeReplace
, data
, 0);
2054 while (bytes_remaining
)
2056 int chunk
= (bytes_remaining
< max_bytes
2057 ? bytes_remaining
: max_bytes
);
2058 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2059 (bytes_remaining
== bytes
2064 bytes_remaining
-= chunk
;
2071 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2072 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2073 "Rotate the values of the cut buffers by the given number of steps;\n\
2074 positive means move values forward, negative means backward.")
2083 display
= FRAME_X_DISPLAY (selected_frame
);
2084 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2085 CHECK_NUMBER (n
, 0);
2088 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2090 initialize_cut_buffers (display
, window
);
2091 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2094 props
[0] = XA_CUT_BUFFER0
;
2095 props
[1] = XA_CUT_BUFFER1
;
2096 props
[2] = XA_CUT_BUFFER2
;
2097 props
[3] = XA_CUT_BUFFER3
;
2098 props
[4] = XA_CUT_BUFFER4
;
2099 props
[5] = XA_CUT_BUFFER5
;
2100 props
[6] = XA_CUT_BUFFER6
;
2101 props
[7] = XA_CUT_BUFFER7
;
2103 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2113 defsubr (&Sx_get_selection_internal
);
2114 defsubr (&Sx_own_selection_internal
);
2115 defsubr (&Sx_disown_selection_internal
);
2116 defsubr (&Sx_selection_owner_p
);
2117 defsubr (&Sx_selection_exists_p
);
2119 #ifdef CUT_BUFFER_SUPPORT
2120 defsubr (&Sx_get_cut_buffer_internal
);
2121 defsubr (&Sx_store_cut_buffer_internal
);
2122 defsubr (&Sx_rotate_cut_buffers_internal
);
2125 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2126 staticpro (&reading_selection_reply
);
2127 reading_selection_window
= 0;
2128 reading_which_selection
= 0;
2130 property_change_wait_list
= 0;
2131 prop_location_identifier
= 0;
2132 property_change_reply
= Fcons (Qnil
, Qnil
);
2133 staticpro (&property_change_reply
);
2135 Vselection_alist
= Qnil
;
2136 staticpro (&Vselection_alist
);
2138 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2139 "An alist associating X Windows selection-types with functions.\n\
2140 These functions are called to convert the selection, with three args:\n\
2141 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2142 a desired type to which the selection should be converted;\n\
2143 and the local selection value (whatever was given to `x-own-selection').\n\
2145 The function should return the value to send to the X server\n\
2146 \(typically a string). A return value of nil\n\
2147 means that the conversion could not be done.\n\
2148 A return value which is the symbol `NULL'\n\
2149 means that a side-effect was executed,\n\
2150 and there is no meaningful selection value.");
2151 Vselection_converter_alist
= Qnil
;
2153 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2154 "A list of functions to be called when Emacs loses an X selection.\n\
2155 \(This happens when some other X client makes its own selection\n\
2156 or when a Lisp program explicitly clears the selection.)\n\
2157 The functions are called with one argument, the selection type\n\
2158 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2159 Vx_lost_selection_hooks
= Qnil
;
2161 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2162 "A list of functions to be called when Emacs answers a selection request.\n\
2163 The functions are called with four arguments:\n\
2164 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2165 - the selection-type which Emacs was asked to convert the\n\
2166 selection into before sending (for example, `STRING' or `LENGTH');\n\
2167 - a flag indicating success or failure for responding to the request.\n\
2168 We might have failed (and declined the request) for any number of reasons,\n\
2169 including being asked for a selection that we no longer own, or being asked\n\
2170 to convert into a type that we don't know about or that is inappropriate.\n\
2171 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2172 it merely informs you that they have happened.");
2173 Vx_sent_selection_hooks
= Qnil
;
2175 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2176 "Number of milliseconds to wait for a selection reply.\n\
2177 If the selection owner doesn't reply in this time, we give up.\n\
2178 A value of 0 means wait as long as necessary. This is initialized from the\n\
2179 \"*selectionTimeout\" resource.");
2180 x_selection_timeout
= 0;
2182 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2183 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2184 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2185 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2186 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2187 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2188 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2189 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2190 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2191 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2192 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2193 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2194 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2195 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2196 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2197 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2199 #ifdef CUT_BUFFER_SUPPORT
2200 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2201 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2202 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2203 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2204 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2205 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2206 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2207 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);