1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 /* Rewritten by jwz */
25 #include "xterm.h" /* for all of the X includes */
26 #include "dispextern.h" /* frame.h seems to want this */
27 #include "frame.h" /* Need this to get the X window of selected_frame */
28 #include "blockinput.h"
32 #define CUT_BUFFER_SUPPORT
34 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
35 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
38 #ifdef CUT_BUFFER_SUPPORT
39 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
40 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
43 static Lisp_Object Vx_lost_selection_hooks
;
44 static Lisp_Object Vx_sent_selection_hooks
;
46 /* If this is a smaller number than the max-request-size of the display,
47 emacs will use INCR selection transfer when the selection is larger
48 than this. The max-request-size is usually around 64k, so if you want
49 emacs to use incremental selection transfers when the selection is
50 smaller than that, set this. I added this mostly for debugging the
51 incremental transfer stuff, but it might improve server performance. */
52 #define MAX_SELECTION_QUANTUM 0xFFFFFF
55 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
57 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
60 /* The timestamp of the last input event Emacs received from the X server. */
61 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
;
218 /* Do protocol to assert ourself as a selection owner.
219 Update the Vselection_alist so that we can reply to later requests for
223 x_own_selection (selection_name
, selection_value
)
224 Lisp_Object selection_name
, selection_value
;
226 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
227 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
228 Time time
= last_event_timestamp
;
230 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
232 CHECK_SYMBOL (selection_name
, 0);
233 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
236 x_catch_errors (display
);
237 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
238 x_check_errors (display
, "Can't set selection: %s");
239 x_uncatch_errors (display
);
242 /* Now update the local cache */
244 Lisp_Object selection_time
;
245 Lisp_Object selection_data
;
246 Lisp_Object prev_value
;
248 selection_time
= long_to_cons ((unsigned long) time
);
249 selection_data
= Fcons (selection_name
,
250 Fcons (selection_value
,
251 Fcons (selection_time
,
252 Fcons (Fselected_frame (), Qnil
))));
253 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
255 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
257 /* If we already owned the selection, remove the old selection data.
258 Perhaps we should destructively modify it instead.
259 Don't use Fdelq as that may QUIT. */
260 if (!NILP (prev_value
))
262 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
263 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
264 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
266 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
273 /* Given a selection-name and desired type, look up our local copy of
274 the selection value and convert it to the type.
275 The value is nil or a string.
276 This function is used both for remote requests
277 and for local x-get-selection-internal.
279 This calls random Lisp code, and may signal or gc. */
282 x_get_local_selection (selection_symbol
, target_type
)
283 Lisp_Object selection_symbol
, target_type
;
285 Lisp_Object local_value
;
286 Lisp_Object handler_fn
, value
, type
, check
;
289 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
291 if (NILP (local_value
)) return Qnil
;
293 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
294 if (EQ (target_type
, QTIMESTAMP
))
297 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
300 else if (EQ (target_type
, QDELETE
))
303 Fx_disown_selection_internal
305 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
310 #if 0 /* #### MULTIPLE doesn't work yet */
311 else if (CONSP (target_type
)
312 && XCONS (target_type
)->car
== QMULTIPLE
)
317 pairs
= XCONS (target_type
)->cdr
;
318 size
= XVECTOR (pairs
)->size
;
319 /* If the target is MULTIPLE, then target_type looks like
320 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
321 We modify the second element of each pair in the vector and
322 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
324 for (i
= 0; i
< size
; i
++)
327 pair
= XVECTOR (pairs
)->contents
[i
];
328 XVECTOR (pair
)->contents
[1]
329 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
330 XVECTOR (pair
)->contents
[1]);
337 /* Don't allow a quit within the converter.
338 When the user types C-g, he would be surprised
339 if by luck it came during a converter. */
340 count
= specpdl_ptr
- specpdl
;
341 specbind (Qinhibit_quit
, Qt
);
343 CHECK_SYMBOL (target_type
, 0);
344 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
345 if (!NILP (handler_fn
))
346 value
= call3 (handler_fn
,
347 selection_symbol
, target_type
,
348 XCONS (XCONS (local_value
)->cdr
)->car
);
351 unbind_to (count
, Qnil
);
354 /* Make sure this value is of a type that we could transmit
355 to another X client. */
359 && SYMBOLP (XCONS (value
)->car
))
360 type
= XCONS (value
)->car
,
361 check
= XCONS (value
)->cdr
;
369 /* Check for a value that cons_to_long could handle. */
370 else if (CONSP (check
)
371 && INTEGERP (XCONS (check
)->car
)
372 && (INTEGERP (XCONS (check
)->cdr
)
374 (CONSP (XCONS (check
)->cdr
)
375 && INTEGERP (XCONS (XCONS (check
)->cdr
)->car
)
376 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
381 Fcons (build_string ("invalid data returned by selection-conversion function"),
382 Fcons (handler_fn
, Fcons (value
, Qnil
))));
385 /* Subroutines of x_reply_selection_request. */
387 /* Send a SelectionNotify event to the requestor with property=None,
388 meaning we were unable to do what they wanted. */
391 x_decline_selection_request (event
)
392 struct input_event
*event
;
394 XSelectionEvent reply
;
395 reply
.type
= SelectionNotify
;
396 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
397 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
398 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
399 reply
.time
= SELECTION_EVENT_TIME (event
);
400 reply
.target
= SELECTION_EVENT_TARGET (event
);
401 reply
.property
= None
;
404 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
406 XFlush (reply
.display
);
410 /* This is the selection request currently being processed.
411 It is set to zero when the request is fully processed. */
412 static struct input_event
*x_selection_current_request
;
414 /* Used as an unwind-protect clause so that, if a selection-converter signals
415 an error, we tell the requestor that we were unable to do what they wanted
416 before we throw to top-level or go into the debugger or whatever. */
419 x_selection_request_lisp_error (ignore
)
422 if (x_selection_current_request
!= 0)
423 x_decline_selection_request (x_selection_current_request
);
428 /* This stuff is so that INCR selections are reentrant (that is, so we can
429 be servicing multiple INCR selection requests simultaneously.) I haven't
430 actually tested that yet. */
432 /* Keep a list of the property changes that are awaited. */
442 struct prop_location
*next
;
445 static struct prop_location
*expect_property_change ();
446 static void wait_for_property_change ();
447 static void unexpect_property_change ();
448 static int waiting_for_other_props_on_window ();
450 static int prop_location_identifier
;
452 static Lisp_Object property_change_reply
;
454 static struct prop_location
*property_change_reply_object
;
456 static struct prop_location
*property_change_wait_list
;
459 queue_selection_requests_unwind (frame
)
462 FRAME_PTR f
= XFRAME (frame
);
465 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
469 /* Return some frame whose display info is DPYINFO.
470 Return nil if there is none. */
473 some_frame_on_display (dpyinfo
)
474 struct x_display_info
*dpyinfo
;
476 Lisp_Object list
, frame
;
478 FOR_EACH_FRAME (list
, frame
)
480 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
487 /* Send the reply to a selection request event EVENT.
488 TYPE is the type of selection data requested.
489 DATA and SIZE describe the data to send, already converted.
490 FORMAT is the unit-size (in bits) of the data to be transmitted. */
493 x_reply_selection_request (event
, format
, data
, size
, type
)
494 struct input_event
*event
;
499 XSelectionEvent reply
;
500 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
501 Window window
= SELECTION_EVENT_REQUESTOR (event
);
503 int format_bytes
= format
/8;
504 int max_bytes
= SELECTION_QUANTUM (display
);
505 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
507 if (max_bytes
> MAX_SELECTION_QUANTUM
)
508 max_bytes
= MAX_SELECTION_QUANTUM
;
510 reply
.type
= SelectionNotify
;
511 reply
.display
= display
;
512 reply
.requestor
= window
;
513 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
514 reply
.time
= SELECTION_EVENT_TIME (event
);
515 reply
.target
= SELECTION_EVENT_TARGET (event
);
516 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
517 if (reply
.property
== None
)
518 reply
.property
= reply
.target
;
520 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
522 x_catch_errors (display
);
524 /* Store the data on the requested property.
525 If the selection is large, only store the first N bytes of it.
527 bytes_remaining
= size
* format_bytes
;
528 if (bytes_remaining
<= max_bytes
)
530 /* Send all the data at once, with minimal handshaking. */
532 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
534 XChangeProperty (display
, window
, reply
.property
, type
, format
,
535 PropModeReplace
, data
, size
);
536 /* At this point, the selection was successfully stored; ack it. */
537 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
541 /* Send an INCR selection. */
542 struct prop_location
*wait_object
;
544 int count
= specpdl_ptr
- specpdl
;
547 frame
= some_frame_on_display (dpyinfo
);
549 /* If the display no longer has frames, we can't expect
550 to get many more selection requests from it, so don't
551 bother trying to queue them. */
554 x_start_queuing_selection_requests (display
);
556 record_unwind_protect (queue_selection_requests_unwind
,
560 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
561 error ("attempt to transfer an INCR to ourself!");
563 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
565 wait_object
= expect_property_change (display
, window
, reply
.property
,
568 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
570 (unsigned char *) &bytes_remaining
, 1);
571 XSelectInput (display
, window
, PropertyChangeMask
);
572 /* Tell 'em the INCR data is there... */
573 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
576 had_errors
= x_had_errors_p (display
);
579 /* First, wait for the requestor to ack by deleting the property.
580 This can run random lisp code (process handlers) or signal. */
582 wait_for_property_change (wait_object
);
584 while (bytes_remaining
)
586 int i
= ((bytes_remaining
< max_bytes
)
593 = expect_property_change (display
, window
, reply
.property
,
596 fprintf (stderr
," INCR adding %d\n", i
);
598 /* Append the next chunk of data to the property. */
599 XChangeProperty (display
, window
, reply
.property
, type
, format
,
600 PropModeAppend
, data
, i
/ format_bytes
);
601 bytes_remaining
-= i
;
604 had_errors
= x_had_errors_p (display
);
610 /* Now wait for the requestor to ack this chunk by deleting the
611 property. This can run random lisp code or signal.
613 wait_for_property_change (wait_object
);
615 /* Now write a zero-length chunk to the property to tell the requestor
618 fprintf (stderr
," INCR done\n");
621 if (! waiting_for_other_props_on_window (display
, window
))
622 XSelectInput (display
, window
, 0L);
624 XChangeProperty (display
, window
, reply
.property
, type
, format
,
625 PropModeReplace
, data
, 0);
627 unbind_to (count
, Qnil
);
631 x_uncatch_errors (display
);
635 /* Handle a SelectionRequest event EVENT.
636 This is called from keyboard.c when such an event is found in the queue. */
639 x_handle_selection_request (event
)
640 struct input_event
*event
;
642 struct gcpro gcpro1
, gcpro2
, gcpro3
;
643 Lisp_Object local_selection_data
;
644 Lisp_Object selection_symbol
;
645 Lisp_Object target_symbol
;
646 Lisp_Object converted_selection
;
647 Time local_selection_time
;
648 Lisp_Object successful_p
;
650 struct x_display_info
*dpyinfo
651 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
653 local_selection_data
= Qnil
;
654 target_symbol
= Qnil
;
655 converted_selection
= Qnil
;
658 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
660 selection_symbol
= x_atom_to_symbol (dpyinfo
,
661 SELECTION_EVENT_DISPLAY (event
),
662 SELECTION_EVENT_SELECTION (event
));
664 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
666 if (NILP (local_selection_data
))
668 /* Someone asked for the selection, but we don't have it any more.
670 x_decline_selection_request (event
);
674 local_selection_time
= (Time
)
675 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
677 if (SELECTION_EVENT_TIME (event
) != CurrentTime
678 && local_selection_time
> SELECTION_EVENT_TIME (event
))
680 /* Someone asked for the selection, and we have one, but not the one
683 x_decline_selection_request (event
);
687 count
= specpdl_ptr
- specpdl
;
688 x_selection_current_request
= event
;
689 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
691 target_symbol
= x_atom_to_symbol (dpyinfo
, SELECTION_EVENT_DISPLAY (event
),
692 SELECTION_EVENT_TARGET (event
));
694 #if 0 /* #### MULTIPLE doesn't work yet */
695 if (EQ (target_symbol
, QMULTIPLE
))
696 target_symbol
= fetch_multiple_target (event
);
699 /* Convert lisp objects back into binary data */
702 = x_get_local_selection (selection_symbol
, target_symbol
);
704 if (! NILP (converted_selection
))
712 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
714 &data
, &type
, &size
, &format
, &nofree
);
716 x_reply_selection_request (event
, format
, data
, size
, type
);
719 /* Indicate we have successfully processed this event. */
720 x_selection_current_request
= 0;
725 unbind_to (count
, Qnil
);
731 /* Let random lisp code notice that the selection has been asked for. */
734 rest
= Vx_sent_selection_hooks
;
735 if (!EQ (rest
, Qunbound
))
736 for (; CONSP (rest
); rest
= Fcdr (rest
))
737 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
741 /* Handle a SelectionClear event EVENT, which indicates that some other
742 client cleared out our previously asserted selection.
743 This is called from keyboard.c when such an event is found in the queue. */
746 x_handle_selection_clear (event
)
747 struct input_event
*event
;
749 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
750 Atom selection
= SELECTION_EVENT_SELECTION (event
);
751 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
753 Lisp_Object selection_symbol
, local_selection_data
;
754 Time local_selection_time
;
755 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
757 selection_symbol
= x_atom_to_symbol (dpyinfo
, display
, selection
);
759 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
761 /* Well, we already believe that we don't own it, so that's just fine. */
762 if (NILP (local_selection_data
)) return;
764 local_selection_time
= (Time
)
765 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
767 /* This SelectionClear is for a selection that we no longer own, so we can
768 disregard it. (That is, we have reasserted the selection since this
769 request was generated.) */
771 if (changed_owner_time
!= CurrentTime
772 && local_selection_time
> changed_owner_time
)
775 /* Otherwise, we're really honest and truly being told to drop it.
776 Don't use Fdelq as that may QUIT;. */
778 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
779 Vselection_alist
= Fcdr (Vselection_alist
);
783 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
784 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
786 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
791 /* Let random lisp code notice that the selection has been stolen. */
795 rest
= Vx_lost_selection_hooks
;
796 if (!EQ (rest
, Qunbound
))
798 for (; CONSP (rest
); rest
= Fcdr (rest
))
799 call1 (Fcar (rest
), selection_symbol
);
800 prepare_menu_bars ();
801 redisplay_preserve_echo_area ();
806 /* Clear all selections that were made from frame F.
807 We do this when about to delete a frame. */
810 x_clear_frame_selections (f
)
816 XSETFRAME (frame
, f
);
818 /* Otherwise, we're really honest and truly being told to drop it.
819 Don't use Fdelq as that may QUIT;. */
821 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
822 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest
)->cdr
)))))))
824 /* Let random Lisp code notice that the selection has been stolen. */
825 Lisp_Object hooks
, selection_symbol
;
827 hooks
= Vx_lost_selection_hooks
;
828 selection_symbol
= Fcar (XCONS (rest
)->cdr
);
830 if (!EQ (hooks
, Qunbound
))
832 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
833 call1 (Fcar (hooks
), selection_symbol
);
834 redisplay_preserve_echo_area ();
836 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
841 /* Nonzero if any properties for DISPLAY and WINDOW
842 are on the list of what we are waiting for. */
845 waiting_for_other_props_on_window (display
, window
)
849 struct prop_location
*rest
= property_change_wait_list
;
851 if (rest
->display
== display
&& rest
->window
== window
)
858 /* Add an entry to the list of property changes we are waiting for.
859 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
860 The return value is a number that uniquely identifies
861 this awaited property change. */
863 static struct prop_location
*
864 expect_property_change (display
, window
, property
, state
)
867 Lisp_Object property
;
870 struct prop_location
*pl
871 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
872 pl
->identifier
= ++prop_location_identifier
;
873 pl
->display
= display
;
875 pl
->property
= property
;
876 pl
->desired_state
= state
;
877 pl
->next
= property_change_wait_list
;
879 property_change_wait_list
= pl
;
883 /* Delete an entry from the list of property changes we are waiting for.
884 IDENTIFIER is the number that uniquely identifies the entry. */
887 unexpect_property_change (location
)
888 struct prop_location
*location
;
890 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
893 if (rest
== location
)
896 prev
->next
= rest
->next
;
898 property_change_wait_list
= rest
->next
;
907 /* Remove the property change expectation element for IDENTIFIER. */
910 wait_for_property_change_unwind (identifierval
)
911 Lisp_Object identifierval
;
913 unexpect_property_change ((struct prop_location
*)
914 (XFASTINT (XCONS (identifierval
)->car
) << 16
915 | XFASTINT (XCONS (identifierval
)->cdr
)));
919 /* Actually wait for a property change.
920 IDENTIFIER should be the value that expect_property_change returned. */
923 wait_for_property_change (location
)
924 struct prop_location
*location
;
927 int count
= specpdl_ptr
- specpdl
;
930 tem
= Fcons (Qnil
, Qnil
);
931 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
932 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
934 /* Make sure to do unexpect_property_change if we quit or err. */
935 record_unwind_protect (wait_for_property_change_unwind
, tem
);
937 XCONS (property_change_reply
)->car
= Qnil
;
939 property_change_reply_object
= location
;
940 /* If the event we are waiting for arrives beyond here, it will set
941 property_change_reply, because property_change_reply_object says so. */
942 if (! location
->arrived
)
944 secs
= x_selection_timeout
/ 1000;
945 usecs
= (x_selection_timeout
% 1000) * 1000;
946 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
948 if (NILP (XCONS (property_change_reply
)->car
))
949 error ("timed out waiting for property-notify event");
952 unbind_to (count
, Qnil
);
955 /* Called from XTread_socket in response to a PropertyNotify event. */
958 x_handle_property_notify (event
)
959 XPropertyEvent
*event
;
961 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
964 if (rest
->property
== event
->atom
965 && rest
->window
== event
->window
966 && rest
->display
== event
->display
967 && rest
->desired_state
== event
->state
)
970 fprintf (stderr
, "Saw expected prop-%s on %s\n",
971 (event
->state
== PropertyDelete
? "delete" : "change"),
972 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
979 /* If this is the one wait_for_property_change is waiting for,
980 tell it to wake up. */
981 if (rest
== property_change_reply_object
)
982 XCONS (property_change_reply
)->car
= Qt
;
985 prev
->next
= rest
->next
;
987 property_change_wait_list
= rest
->next
;
995 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
996 (event
->state
== PropertyDelete
? "delete" : "change"),
997 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
998 event
->display
, event
->atom
))
1005 #if 0 /* #### MULTIPLE doesn't work yet */
1008 fetch_multiple_target (event
)
1009 XSelectionRequestEvent
*event
;
1011 Display
*display
= event
->display
;
1012 Window window
= event
->requestor
;
1013 Atom target
= event
->target
;
1014 Atom selection_atom
= event
->selection
;
1019 x_get_window_property_as_lisp_data (display
, window
, target
,
1020 QMULTIPLE
, selection_atom
));
1024 copy_multiple_data (obj
)
1031 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1033 CHECK_VECTOR (obj
, 0);
1034 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1035 for (i
= 0; i
< size
; i
++)
1037 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1038 CHECK_VECTOR (vec2
, 0);
1039 if (XVECTOR (vec2
)->size
!= 2)
1040 /* ??? Confusing error message */
1041 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1042 Fcons (vec2
, Qnil
)));
1043 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1044 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1045 = XVECTOR (vec2
)->contents
[0];
1046 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1047 = XVECTOR (vec2
)->contents
[1];
1055 /* Variables for communication with x_handle_selection_notify. */
1056 static Atom reading_which_selection
;
1057 static Lisp_Object reading_selection_reply
;
1058 static Window reading_selection_window
;
1060 /* Do protocol to read selection-data from the server.
1061 Converts this to Lisp data and returns it. */
1064 x_get_foreign_selection (selection_symbol
, target_type
)
1065 Lisp_Object selection_symbol
, target_type
;
1067 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1068 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1069 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1070 Time requestor_time
= last_event_timestamp
;
1071 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1072 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1075 int count
= specpdl_ptr
- specpdl
;
1078 if (CONSP (target_type
))
1079 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1081 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1084 x_catch_errors (display
);
1085 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1086 requestor_window
, requestor_time
);
1089 /* Prepare to block until the reply has been read. */
1090 reading_selection_window
= requestor_window
;
1091 reading_which_selection
= selection_atom
;
1092 XCONS (reading_selection_reply
)->car
= Qnil
;
1094 frame
= some_frame_on_display (dpyinfo
);
1096 /* If the display no longer has frames, we can't expect
1097 to get many more selection requests from it, so don't
1098 bother trying to queue them. */
1101 x_start_queuing_selection_requests (display
);
1103 record_unwind_protect (queue_selection_requests_unwind
,
1108 /* This allows quits. Also, don't wait forever. */
1109 secs
= x_selection_timeout
/ 1000;
1110 usecs
= (x_selection_timeout
% 1000) * 1000;
1111 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1114 x_check_errors (display
, "Cannot get selection: %s");
1115 x_uncatch_errors (display
);
1116 unbind_to (count
, Qnil
);
1119 if (NILP (XCONS (reading_selection_reply
)->car
))
1120 error ("timed out waiting for reply from selection owner");
1122 /* Otherwise, the selection is waiting for us on the requested property. */
1124 x_get_window_property_as_lisp_data (display
, requestor_window
,
1125 target_property
, target_type
,
1129 /* Subroutines of x_get_window_property_as_lisp_data */
1132 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1133 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1138 unsigned char **data_ret
;
1140 Atom
*actual_type_ret
;
1141 int *actual_format_ret
;
1142 unsigned long *actual_size_ret
;
1146 unsigned long bytes_remaining
;
1148 unsigned char *tmp_data
= 0;
1150 int buffer_size
= SELECTION_QUANTUM (display
);
1151 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1154 /* First probe the thing to find out how big it is. */
1155 result
= XGetWindowProperty (display
, window
, property
,
1156 0L, 0L, False
, AnyPropertyType
,
1157 actual_type_ret
, actual_format_ret
,
1159 &bytes_remaining
, &tmp_data
);
1160 if (result
!= Success
)
1167 xfree ((char *) tmp_data
);
1169 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1175 total_size
= bytes_remaining
+ 1;
1176 *data_ret
= (unsigned char *) xmalloc (total_size
);
1178 /* Now read, until weve gotten it all. */
1179 while (bytes_remaining
)
1182 int last
= bytes_remaining
;
1185 = XGetWindowProperty (display
, window
, property
,
1186 (long)offset
/4, (long)buffer_size
/4,
1189 actual_type_ret
, actual_format_ret
,
1190 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1192 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1194 /* If this doesn't return Success at this point, it means that
1195 some clod deleted the selection while we were in the midst of
1196 reading it. Deal with that, I guess....
1198 if (result
!= Success
) break;
1199 *actual_size_ret
*= *actual_format_ret
/ 8;
1200 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1201 offset
+= *actual_size_ret
;
1202 xfree ((char *) tmp_data
);
1207 *bytes_ret
= offset
;
1211 receive_incremental_selection (display
, window
, property
, target_type
,
1212 min_size_bytes
, data_ret
, size_bytes_ret
,
1213 type_ret
, format_ret
, size_ret
)
1217 Lisp_Object target_type
; /* for error messages only */
1218 unsigned int min_size_bytes
;
1219 unsigned char **data_ret
;
1220 int *size_bytes_ret
;
1222 unsigned long *size_ret
;
1226 struct prop_location
*wait_object
;
1227 *size_bytes_ret
= min_size_bytes
;
1228 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1230 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1233 /* At this point, we have read an INCR property.
1234 Delete the property to ack it.
1235 (But first, prepare to receive the next event in this handshake.)
1237 Now, we must loop, waiting for the sending window to put a value on
1238 that property, then reading the property, then deleting it to ack.
1239 We are done when the sender places a property of length 0.
1242 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1243 XDeleteProperty (display
, window
, property
);
1244 wait_object
= expect_property_change (display
, window
, property
,
1251 unsigned char *tmp_data
;
1253 wait_for_property_change (wait_object
);
1254 /* expect it again immediately, because x_get_window_property may
1255 .. no it wont, I dont get it.
1256 .. Ok, I get it now, the Xt code that implements INCR is broken.
1258 x_get_window_property (display
, window
, property
,
1259 &tmp_data
, &tmp_size_bytes
,
1260 type_ret
, format_ret
, size_ret
, 1);
1262 if (tmp_size_bytes
== 0) /* we're done */
1265 fprintf (stderr
, " read INCR done\n");
1267 if (! waiting_for_other_props_on_window (display
, window
))
1268 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1269 unexpect_property_change (wait_object
);
1270 if (tmp_data
) xfree (tmp_data
);
1275 XDeleteProperty (display
, window
, property
);
1276 wait_object
= expect_property_change (display
, window
, property
,
1282 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1284 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1287 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1288 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1290 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1291 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1293 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1294 offset
+= tmp_size_bytes
;
1299 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1300 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1301 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1304 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1309 Lisp_Object target_type
; /* for error messages only */
1310 Atom selection_atom
; /* for error messages only */
1314 unsigned long actual_size
;
1315 unsigned char *data
= 0;
1318 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1320 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1321 &actual_type
, &actual_format
, &actual_size
, 1);
1324 int there_is_a_selection_owner
;
1326 there_is_a_selection_owner
1327 = XGetSelectionOwner (display
, selection_atom
);
1329 while (1) /* Note debugger can no longer return, so this is obsolete */
1331 there_is_a_selection_owner
?
1332 Fcons (build_string ("selection owner couldn't convert"),
1334 ? Fcons (target_type
,
1335 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1338 : Fcons (target_type
, Qnil
))
1339 : Fcons (build_string ("no selection"),
1340 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1345 if (actual_type
== dpyinfo
->Xatom_INCR
)
1347 /* That wasn't really the data, just the beginning. */
1349 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1351 XFree ((char *) data
);
1353 receive_incremental_selection (display
, window
, property
, target_type
,
1354 min_size_bytes
, &data
, &bytes
,
1355 &actual_type
, &actual_format
,
1360 XDeleteProperty (display
, window
, property
);
1364 /* It's been read. Now convert it to a lisp object in some semi-rational
1366 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1367 actual_type
, actual_format
);
1369 xfree ((char *) data
);
1373 /* These functions convert from the selection data read from the server into
1374 something that we can use from Lisp, and vice versa.
1376 Type: Format: Size: Lisp Type:
1377 ----- ------- ----- -----------
1380 ATOM 32 > 1 Vector of Symbols
1382 * 16 > 1 Vector of Integers
1383 * 32 1 if <=16 bits: Integer
1384 if > 16 bits: Cons of top16, bot16
1385 * 32 > 1 Vector of the above
1387 When converting a Lisp number to C, it is assumed to be of format 16 if
1388 it is an integer, and of format 32 if it is a cons of two integers.
1390 When converting a vector of numbers from Lisp to C, it is assumed to be
1391 of format 16 if every element in the vector is an integer, and is assumed
1392 to be of format 32 if any element is a cons of two integers.
1394 When converting an object to C, it may be of the form (SYMBOL . <data>)
1395 where SYMBOL is what we should claim that the type is. Format and
1396 representation are as above. */
1401 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1403 unsigned char *data
;
1407 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1409 if (type
== dpyinfo
->Xatom_NULL
)
1412 /* Convert any 8-bit data to a string, for compactness. */
1413 else if (format
== 8)
1414 return make_string ((char *) data
, size
);
1416 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1417 a vector of symbols.
1419 else if (type
== XA_ATOM
)
1422 if (size
== sizeof (Atom
))
1423 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1426 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1427 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1428 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1429 ((Atom
*) data
) [i
]));
1434 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1435 If the number is > 16 bits, convert it to a cons of integers,
1436 16 bits in each half.
1438 else if (format
== 32 && size
== sizeof (long))
1439 return long_to_cons (((unsigned long *) data
) [0]);
1440 else if (format
== 16 && size
== sizeof (short))
1441 return make_number ((int) (((unsigned short *) data
) [0]));
1443 /* Convert any other kind of data to a vector of numbers, represented
1444 as above (as an integer, or a cons of two 16 bit integers.)
1446 else if (format
== 16)
1449 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1450 for (i
= 0; i
< size
/ 4; i
++)
1452 int j
= (int) ((unsigned short *) data
) [i
];
1453 Faset (v
, i
, make_number (j
));
1460 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1461 for (i
= 0; i
< size
/ 4; i
++)
1463 unsigned long j
= ((unsigned long *) data
) [i
];
1464 Faset (v
, i
, long_to_cons (j
));
1472 lisp_data_to_selection_data (display
, obj
,
1473 data_ret
, type_ret
, size_ret
,
1474 format_ret
, nofree_ret
)
1477 unsigned char **data_ret
;
1479 unsigned int *size_ret
;
1483 Lisp_Object type
= Qnil
;
1484 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1488 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1490 type
= XCONS (obj
)->car
;
1491 obj
= XCONS (obj
)->cdr
;
1492 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1493 obj
= XCONS (obj
)->car
;
1496 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1497 { /* This is not the same as declining */
1503 else if (STRINGP (obj
))
1506 *size_ret
= XSTRING (obj
)->size
;
1507 *data_ret
= XSTRING (obj
)->data
;
1509 if (NILP (type
)) type
= QSTRING
;
1511 else if (SYMBOLP (obj
))
1515 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1516 (*data_ret
) [sizeof (Atom
)] = 0;
1517 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1518 if (NILP (type
)) type
= QATOM
;
1520 else if (INTEGERP (obj
)
1521 && XINT (obj
) < 0xFFFF
1522 && XINT (obj
) > -0xFFFF)
1526 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1527 (*data_ret
) [sizeof (short)] = 0;
1528 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1529 if (NILP (type
)) type
= QINTEGER
;
1531 else if (INTEGERP (obj
)
1532 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1533 && (INTEGERP (XCONS (obj
)->cdr
)
1534 || (CONSP (XCONS (obj
)->cdr
)
1535 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1539 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1540 (*data_ret
) [sizeof (long)] = 0;
1541 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1542 if (NILP (type
)) type
= QINTEGER
;
1544 else if (VECTORP (obj
))
1546 /* Lisp_Vectors may represent a set of ATOMs;
1547 a set of 16 or 32 bit INTEGERs;
1548 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1552 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1553 /* This vector is an ATOM set */
1555 if (NILP (type
)) type
= QATOM
;
1556 *size_ret
= XVECTOR (obj
)->size
;
1558 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1559 for (i
= 0; i
< *size_ret
; i
++)
1560 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1561 (*(Atom
**) data_ret
) [i
]
1562 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1564 Fsignal (Qerror
, /* Qselection_error */
1566 ("all elements of selection vector must have same type"),
1567 Fcons (obj
, Qnil
)));
1569 #if 0 /* #### MULTIPLE doesn't work yet */
1570 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1571 /* This vector is an ATOM_PAIR set */
1573 if (NILP (type
)) type
= QATOM_PAIR
;
1574 *size_ret
= XVECTOR (obj
)->size
;
1576 *data_ret
= (unsigned char *)
1577 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1578 for (i
= 0; i
< *size_ret
; i
++)
1579 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1581 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1582 if (XVECTOR (pair
)->size
!= 2)
1585 ("elements of the vector must be vectors of exactly two elements"),
1586 Fcons (pair
, Qnil
)));
1588 (*(Atom
**) data_ret
) [i
* 2]
1589 = symbol_to_x_atom (dpyinfo
, display
,
1590 XVECTOR (pair
)->contents
[0]);
1591 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1592 = symbol_to_x_atom (dpyinfo
, display
,
1593 XVECTOR (pair
)->contents
[1]);
1598 ("all elements of the vector must be of the same type"),
1599 Fcons (obj
, Qnil
)));
1604 /* This vector is an INTEGER set, or something like it */
1606 *size_ret
= XVECTOR (obj
)->size
;
1607 if (NILP (type
)) type
= QINTEGER
;
1609 for (i
= 0; i
< *size_ret
; i
++)
1610 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1612 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1613 Fsignal (Qerror
, /* Qselection_error */
1615 ("elements of selection vector must be integers or conses of integers"),
1616 Fcons (obj
, Qnil
)));
1618 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1619 for (i
= 0; i
< *size_ret
; i
++)
1620 if (*format_ret
== 32)
1621 (*((unsigned long **) data_ret
)) [i
]
1622 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1624 (*((unsigned short **) data_ret
)) [i
]
1625 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1629 Fsignal (Qerror
, /* Qselection_error */
1630 Fcons (build_string ("unrecognised selection data"),
1631 Fcons (obj
, Qnil
)));
1633 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1637 clean_local_selection_data (obj
)
1641 && INTEGERP (XCONS (obj
)->car
)
1642 && CONSP (XCONS (obj
)->cdr
)
1643 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1644 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1645 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1648 && INTEGERP (XCONS (obj
)->car
)
1649 && INTEGERP (XCONS (obj
)->cdr
))
1651 if (XINT (XCONS (obj
)->car
) == 0)
1652 return XCONS (obj
)->cdr
;
1653 if (XINT (XCONS (obj
)->car
) == -1)
1654 return make_number (- XINT (XCONS (obj
)->cdr
));
1659 int size
= XVECTOR (obj
)->size
;
1662 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1663 copy
= Fmake_vector (size
, Qnil
);
1664 for (i
= 0; i
< size
; i
++)
1665 XVECTOR (copy
)->contents
[i
]
1666 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1672 /* Called from XTread_socket to handle SelectionNotify events.
1673 If it's the selection we are waiting for, stop waiting. */
1676 x_handle_selection_notify (event
)
1677 XSelectionEvent
*event
;
1679 if (event
->requestor
!= reading_selection_window
)
1681 if (event
->selection
!= reading_which_selection
)
1684 XCONS (reading_selection_reply
)->car
= Qt
;
1688 DEFUN ("x-own-selection-internal",
1689 Fx_own_selection_internal
, Sx_own_selection_internal
,
1691 "Assert an X selection of the given TYPE with the given VALUE.\n\
1692 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1693 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1694 VALUE is typically a string, or a cons of two markers, but may be\n\
1695 anything that the functions on `selection-converter-alist' know about.")
1696 (selection_name
, selection_value
)
1697 Lisp_Object selection_name
, selection_value
;
1700 CHECK_SYMBOL (selection_name
, 0);
1701 if (NILP (selection_value
)) error ("selection-value may not be nil.");
1702 x_own_selection (selection_name
, selection_value
);
1703 return selection_value
;
1707 /* Request the selection value from the owner. If we are the owner,
1708 simply return our selection value. If we are not the owner, this
1709 will block until all of the data has arrived. */
1711 DEFUN ("x-get-selection-internal",
1712 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1713 "Return text selected from some X window.\n\
1714 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1715 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1716 TYPE is the type of data desired, typically `STRING'.")
1717 (selection_symbol
, target_type
)
1718 Lisp_Object selection_symbol
, target_type
;
1720 Lisp_Object val
= Qnil
;
1721 struct gcpro gcpro1
, gcpro2
;
1722 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1724 CHECK_SYMBOL (selection_symbol
, 0);
1726 #if 0 /* #### MULTIPLE doesn't work yet */
1727 if (CONSP (target_type
)
1728 && XCONS (target_type
)->car
== QMULTIPLE
)
1730 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1731 /* So we don't destructively modify this... */
1732 target_type
= copy_multiple_data (target_type
);
1736 CHECK_SYMBOL (target_type
, 0);
1738 val
= x_get_local_selection (selection_symbol
, target_type
);
1742 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1747 && SYMBOLP (XCONS (val
)->car
))
1749 val
= XCONS (val
)->cdr
;
1750 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1751 val
= XCONS (val
)->car
;
1753 val
= clean_local_selection_data (val
);
1759 DEFUN ("x-disown-selection-internal",
1760 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1761 "If we own the selection SELECTION, disown it.\n\
1762 Disowning it means there is no such selection.")
1764 Lisp_Object selection
;
1768 Atom selection_atom
;
1769 XSelectionClearEvent event
;
1771 struct x_display_info
*dpyinfo
;
1774 display
= FRAME_X_DISPLAY (selected_frame
);
1775 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1776 CHECK_SYMBOL (selection
, 0);
1778 timestamp
= last_event_timestamp
;
1780 timestamp
= cons_to_long (time
);
1782 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1783 return Qnil
; /* Don't disown the selection when we're not the owner. */
1785 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1788 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1791 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1792 generated for a window which owns the selection when that window sets
1793 the selection owner to None. The NCD server does, the MIT Sun4 server
1794 doesn't. So we synthesize one; this means we might get two, but
1795 that's ok, because the second one won't have any effect. */
1796 SELECTION_EVENT_DISPLAY (&event
) = display
;
1797 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1798 SELECTION_EVENT_TIME (&event
) = timestamp
;
1799 x_handle_selection_clear (&event
);
1804 /* Get rid of all the selections in buffer BUFFER.
1805 This is used when we kill a buffer. */
1808 x_disown_buffer_selections (buffer
)
1812 struct buffer
*buf
= XBUFFER (buffer
);
1814 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1816 Lisp_Object elt
, value
;
1817 elt
= XCONS (tail
)->car
;
1818 value
= XCONS (elt
)->cdr
;
1819 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1820 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1821 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1825 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1827 "Whether the current Emacs process owns the given X Selection.\n\
1828 The arg should be the name of the selection in question, typically one of\n\
1829 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1830 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1831 For convenience, the symbol nil is the same as `PRIMARY',\n\
1832 and t is the same as `SECONDARY'.)")
1834 Lisp_Object selection
;
1837 CHECK_SYMBOL (selection
, 0);
1838 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1839 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1841 if (NILP (Fassq (selection
, Vselection_alist
)))
1846 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1848 "Whether there is an owner for the given X Selection.\n\
1849 The arg should be the name of the selection in question, typically one of\n\
1850 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1851 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1852 For convenience, the symbol nil is the same as `PRIMARY',\n\
1853 and t is the same as `SECONDARY'.)")
1855 Lisp_Object selection
;
1861 /* It should be safe to call this before we have an X frame. */
1862 if (! FRAME_X_P (selected_frame
))
1865 dpy
= FRAME_X_DISPLAY (selected_frame
);
1866 CHECK_SYMBOL (selection
, 0);
1867 if (!NILP (Fx_selection_owner_p (selection
)))
1869 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1870 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1871 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1876 owner
= XGetSelectionOwner (dpy
, atom
);
1878 return (owner
? Qt
: Qnil
);
1882 #ifdef CUT_BUFFER_SUPPORT
1884 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1886 initialize_cut_buffers (display
, window
)
1890 unsigned char *data
= (unsigned char *) "";
1892 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1893 PropModeAppend, data, 0)
1894 FROB (XA_CUT_BUFFER0
);
1895 FROB (XA_CUT_BUFFER1
);
1896 FROB (XA_CUT_BUFFER2
);
1897 FROB (XA_CUT_BUFFER3
);
1898 FROB (XA_CUT_BUFFER4
);
1899 FROB (XA_CUT_BUFFER5
);
1900 FROB (XA_CUT_BUFFER6
);
1901 FROB (XA_CUT_BUFFER7
);
1907 #define CHECK_CUT_BUFFER(symbol,n) \
1908 { CHECK_SYMBOL ((symbol), (n)); \
1909 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1910 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1911 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1912 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1914 Fcons (build_string ("doesn't name a cut buffer"), \
1915 Fcons ((symbol), Qnil))); \
1918 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1919 Sx_get_cut_buffer_internal
, 1, 1, 0,
1920 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1926 unsigned char *data
;
1933 struct x_display_info
*dpyinfo
;
1936 display
= FRAME_X_DISPLAY (selected_frame
);
1937 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1938 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1939 CHECK_CUT_BUFFER (buffer
, 0);
1940 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1942 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1943 &type
, &format
, &size
, 0);
1944 if (!data
) return Qnil
;
1946 if (format
!= 8 || type
!= XA_STRING
)
1948 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1949 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
1950 Fcons (make_number (format
), Qnil
))));
1952 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1958 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
1959 Sx_store_cut_buffer_internal
, 2, 2, 0,
1960 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1962 Lisp_Object buffer
, string
;
1966 unsigned char *data
;
1968 int bytes_remaining
;
1973 display
= FRAME_X_DISPLAY (selected_frame
);
1974 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1976 max_bytes
= SELECTION_QUANTUM (display
);
1977 if (max_bytes
> MAX_SELECTION_QUANTUM
)
1978 max_bytes
= MAX_SELECTION_QUANTUM
;
1980 CHECK_CUT_BUFFER (buffer
, 0);
1981 CHECK_STRING (string
, 0);
1982 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1984 data
= (unsigned char *) XSTRING (string
)->data
;
1985 bytes
= XSTRING (string
)->size
;
1986 bytes_remaining
= bytes
;
1988 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
1990 initialize_cut_buffers (display
, window
);
1991 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
1996 /* Don't mess up with an empty value. */
1997 if (!bytes_remaining
)
1998 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1999 PropModeReplace
, data
, 0);
2001 while (bytes_remaining
)
2003 int chunk
= (bytes_remaining
< max_bytes
2004 ? bytes_remaining
: max_bytes
);
2005 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2006 (bytes_remaining
== bytes
2011 bytes_remaining
-= chunk
;
2018 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2019 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2020 "Rotate the values of the cut buffers by the given number of steps;\n\
2021 positive means move values forward, negative means backward.")
2030 display
= FRAME_X_DISPLAY (selected_frame
);
2031 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2032 CHECK_NUMBER (n
, 0);
2035 if (! FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
)
2037 initialize_cut_buffers (display
, window
);
2038 FRAME_X_DISPLAY_INFO (selected_frame
)->cut_buffers_initialized
= 1;
2041 props
[0] = XA_CUT_BUFFER0
;
2042 props
[1] = XA_CUT_BUFFER1
;
2043 props
[2] = XA_CUT_BUFFER2
;
2044 props
[3] = XA_CUT_BUFFER3
;
2045 props
[4] = XA_CUT_BUFFER4
;
2046 props
[5] = XA_CUT_BUFFER5
;
2047 props
[6] = XA_CUT_BUFFER6
;
2048 props
[7] = XA_CUT_BUFFER7
;
2050 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2060 defsubr (&Sx_get_selection_internal
);
2061 defsubr (&Sx_own_selection_internal
);
2062 defsubr (&Sx_disown_selection_internal
);
2063 defsubr (&Sx_selection_owner_p
);
2064 defsubr (&Sx_selection_exists_p
);
2066 #ifdef CUT_BUFFER_SUPPORT
2067 defsubr (&Sx_get_cut_buffer_internal
);
2068 defsubr (&Sx_store_cut_buffer_internal
);
2069 defsubr (&Sx_rotate_cut_buffers_internal
);
2072 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2073 staticpro (&reading_selection_reply
);
2074 reading_selection_window
= 0;
2075 reading_which_selection
= 0;
2077 property_change_wait_list
= 0;
2078 prop_location_identifier
= 0;
2079 property_change_reply
= Fcons (Qnil
, Qnil
);
2080 staticpro (&property_change_reply
);
2082 Vselection_alist
= Qnil
;
2083 staticpro (&Vselection_alist
);
2085 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2086 "An alist associating X Windows selection-types with functions.\n\
2087 These functions are called to convert the selection, with three args:\n\
2088 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2089 a desired type to which the selection should be converted;\n\
2090 and the local selection value (whatever was given to `x-own-selection').\n\
2092 The function should return the value to send to the X server\n\
2093 \(typically a string). A return value of nil\n\
2094 means that the conversion could not be done.\n\
2095 A return value which is the symbol `NULL'\n\
2096 means that a side-effect was executed,\n\
2097 and there is no meaningful selection value.");
2098 Vselection_converter_alist
= Qnil
;
2100 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2101 "A list of functions to be called when Emacs loses an X selection.\n\
2102 \(This happens when some other X client makes its own selection\n\
2103 or when a Lisp program explicitly clears the selection.)\n\
2104 The functions are called with one argument, the selection type\n\
2105 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
2106 Vx_lost_selection_hooks
= Qnil
;
2108 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2109 "A list of functions to be called when Emacs answers a selection request.\n\
2110 The functions are called with four arguments:\n\
2111 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2112 - the selection-type which Emacs was asked to convert the\n\
2113 selection into before sending (for example, `STRING' or `LENGTH');\n\
2114 - a flag indicating success or failure for responding to the request.\n\
2115 We might have failed (and declined the request) for any number of reasons,\n\
2116 including being asked for a selection that we no longer own, or being asked\n\
2117 to convert into a type that we don't know about or that is inappropriate.\n\
2118 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2119 it merely informs you that they have happened.");
2120 Vx_sent_selection_hooks
= Qnil
;
2122 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2123 "Number of milliseconds to wait for a selection reply.\n\
2124 If the selection owner doens't reply in this time, we give up.\n\
2125 A value of 0 means wait as long as necessary. This is initialized from the\n\
2126 \"*selectionTimeout\" resource.");
2127 x_selection_timeout
= 0;
2129 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2130 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2131 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2132 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2133 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2134 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2135 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2136 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2137 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2138 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2139 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2140 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2141 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2142 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2143 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2144 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2146 #ifdef CUT_BUFFER_SUPPORT
2147 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2148 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2149 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2150 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2151 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2152 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2153 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2154 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);