1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
21 /* Rewritten by jwz */
25 #include "xterm.h" /* for all of the X includes */
26 #include "dispextern.h" /* frame.h seems to want this */
27 #include "frame.h" /* Need this to get the X window of selected_frame */
28 #include "blockinput.h"
32 #define CUT_BUFFER_SUPPORT
34 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
35 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
38 #ifdef CUT_BUFFER_SUPPORT
39 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
40 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
43 Lisp_Object Vx_lost_selection_hooks
;
44 Lisp_Object Vx_sent_selection_hooks
;
46 /* If this is a smaller number than the max-request-size of the display,
47 emacs will use INCR selection transfer when the selection is larger
48 than this. The max-request-size is usually around 64k, so if you want
49 emacs to use incremental selection transfers when the selection is
50 smaller than that, set this. I added this mostly for debugging the
51 incremental transfer stuff, but it might improve server performance.
53 #define MAX_SELECTION_QUANTUM 0xFFFFFF
56 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
58 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
61 /* The timestamp of the last input event Emacs received from the X server. */
62 unsigned long last_event_timestamp
;
64 /* This is an association list whose elements are of the form
65 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
66 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
67 SELECTION-VALUE is the value that emacs owns for that selection.
68 It may be any kind of Lisp object.
69 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
70 as a cons of two 16-bit numbers (making a 32 bit time.)
71 FRAME is the frame for which we made the selection.
72 If there is an entry in this alist, then it can be assumed that Emacs owns
74 The only (eq) parts of this list that are visible from Lisp are the
77 Lisp_Object Vselection_alist
;
79 /* This is an alist whose CARs are selection-types (whose names are the same
80 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
81 call to convert the given Emacs selection value to a string representing
82 the given selection type. This is for Lisp-level extension of the emacs
85 Lisp_Object Vselection_converter_alist
;
87 /* If the selection owner takes too long to reply to a selection request,
88 we give up on it. This is in milliseconds (0 = no timeout.)
90 int x_selection_timeout
;
92 /* Utility functions */
94 static void lisp_data_to_selection_data ();
95 static Lisp_Object
selection_data_to_lisp_data ();
96 static Lisp_Object
x_get_window_property_as_lisp_data ();
98 /* This converts a Lisp symbol to a server Atom, avoiding a server
99 roundtrip whenever possible. */
102 symbol_to_x_atom (dpyinfo
, display
, sym
)
103 struct x_display_info
*dpyinfo
;
108 if (NILP (sym
)) return 0;
109 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
110 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
111 if (EQ (sym
, QSTRING
)) return XA_STRING
;
112 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
113 if (EQ (sym
, QATOM
)) return XA_ATOM
;
114 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
115 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
116 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
117 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
118 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
119 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
120 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
121 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
122 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
123 #ifdef CUT_BUFFER_SUPPORT
124 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
125 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
126 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
127 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
128 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
129 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
130 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
131 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
133 if (!SYMBOLP (sym
)) abort ();
136 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
139 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
145 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
146 and calls to intern whenever possible. */
149 x_atom_to_symbol (dpyinfo
, display
, atom
)
150 struct x_display_info
*dpyinfo
;
156 if (! atom
) return Qnil
;
169 #ifdef CUT_BUFFER_SUPPORT
189 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
191 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
193 if (atom
== dpyinfo
->Xatom_TEXT
)
195 if (atom
== dpyinfo
->Xatom_DELETE
)
197 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
199 if (atom
== dpyinfo
->Xatom_INCR
)
201 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
203 if (atom
== dpyinfo
->Xatom_TARGETS
)
205 if (atom
== dpyinfo
->Xatom_NULL
)
209 str
= XGetAtomName (display
, atom
);
212 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
214 if (! str
) return Qnil
;
222 /* Do protocol to assert ourself as a selection owner.
223 Update the Vselection_alist so that we can reply to later requests for
227 x_own_selection (selection_name
, selection_value
)
228 Lisp_Object selection_name
, selection_value
;
230 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
231 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
232 Time time
= last_event_timestamp
;
234 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
236 CHECK_SYMBOL (selection_name
, 0);
237 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
240 x_catch_errors (display
);
241 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
242 x_check_errors (display
, "Can't set selection: %s");
243 x_uncatch_errors (display
);
246 /* Now update the local cache */
248 Lisp_Object selection_time
;
249 Lisp_Object selection_data
;
250 Lisp_Object prev_value
;
252 selection_time
= long_to_cons ((unsigned long) time
);
253 selection_data
= Fcons (selection_name
,
254 Fcons (selection_value
,
255 Fcons (selection_time
,
256 Fcons (Fselected_frame (), Qnil
))));
257 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
259 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
261 /* If we already owned the selection, remove the old selection data.
262 Perhaps we should destructively modify it instead.
263 Don't use Fdelq as that may QUIT. */
264 if (!NILP (prev_value
))
266 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
267 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
268 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
270 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
277 /* Given a selection-name and desired type, look up our local copy of
278 the selection value and convert it to the type.
279 The value is nil or a string.
280 This function is used both for remote requests
281 and for local x-get-selection-internal.
283 This calls random Lisp code, and may signal or gc. */
286 x_get_local_selection (selection_symbol
, target_type
)
287 Lisp_Object selection_symbol
, target_type
;
289 Lisp_Object local_value
;
290 Lisp_Object handler_fn
, value
, type
, check
;
293 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
295 if (NILP (local_value
)) return Qnil
;
297 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
298 if (EQ (target_type
, QTIMESTAMP
))
301 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
304 else if (EQ (target_type
, QDELETE
))
307 Fx_disown_selection_internal
309 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
314 #if 0 /* #### MULTIPLE doesn't work yet */
315 else if (CONSP (target_type
)
316 && XCONS (target_type
)->car
== QMULTIPLE
)
321 pairs
= XCONS (target_type
)->cdr
;
322 size
= XVECTOR (pairs
)->size
;
323 /* If the target is MULTIPLE, then target_type looks like
324 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
325 We modify the second element of each pair in the vector and
326 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
328 for (i
= 0; i
< size
; i
++)
331 pair
= XVECTOR (pairs
)->contents
[i
];
332 XVECTOR (pair
)->contents
[1]
333 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
334 XVECTOR (pair
)->contents
[1]);
341 /* Don't allow a quit within the converter.
342 When the user types C-g, he would be surprised
343 if by luck it came during a converter. */
344 count
= specpdl_ptr
- specpdl
;
345 specbind (Qinhibit_quit
, Qt
);
347 CHECK_SYMBOL (target_type
, 0);
348 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
349 if (!NILP (handler_fn
))
350 value
= call3 (handler_fn
,
351 selection_symbol
, target_type
,
352 XCONS (XCONS (local_value
)->cdr
)->car
);
355 unbind_to (count
, Qnil
);
358 /* Make sure this value is of a type that we could transmit
359 to another X client. */
363 && SYMBOLP (XCONS (value
)->car
))
364 type
= XCONS (value
)->car
,
365 check
= XCONS (value
)->cdr
;
373 /* Check for a value that cons_to_long could handle. */
374 else if (CONSP (check
)
375 && INTEGERP (XCONS (check
)->car
)
376 && (INTEGERP (XCONS (check
)->cdr
)
378 (CONSP (XCONS (check
)->cdr
)
379 && INTEGERP (XCONS (XCONS (check
)->cdr
)->car
)
380 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
385 Fcons (build_string ("invalid data returned by selection-conversion function"),
386 Fcons (handler_fn
, Fcons (value
, Qnil
))));
389 /* Subroutines of x_reply_selection_request. */
391 /* Send a SelectionNotify event to the requestor with property=None,
392 meaning we were unable to do what they wanted. */
395 x_decline_selection_request (event
)
396 struct input_event
*event
;
398 XSelectionEvent reply
;
399 reply
.type
= SelectionNotify
;
400 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
401 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
402 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
403 reply
.time
= SELECTION_EVENT_TIME (event
);
404 reply
.target
= SELECTION_EVENT_TARGET (event
);
405 reply
.property
= None
;
408 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
410 XFlush (reply
.display
);
414 /* This is the selection request currently being processed.
415 It is set to zero when the request is fully processed. */
416 static struct input_event
*x_selection_current_request
;
418 /* Used as an unwind-protect clause so that, if a selection-converter signals
419 an error, we tell the requestor that we were unable to do what they wanted
420 before we throw to top-level or go into the debugger or whatever. */
423 x_selection_request_lisp_error (ignore
)
426 if (x_selection_current_request
!= 0)
427 x_decline_selection_request (x_selection_current_request
);
432 /* This stuff is so that INCR selections are reentrant (that is, so we can
433 be servicing multiple INCR selection requests simultaneously.) I haven't
434 actually tested that yet. */
436 /* Keep a list of the property changes that are awaited. */
446 struct prop_location
*next
;
449 static struct prop_location
*expect_property_change ();
450 static void wait_for_property_change ();
451 static void unexpect_property_change ();
452 static int waiting_for_other_props_on_window ();
454 static int prop_location_identifier
;
456 static Lisp_Object property_change_reply
;
458 static struct prop_location
*property_change_reply_object
;
460 static struct prop_location
*property_change_wait_list
;
462 /* Send the reply to a selection request event EVENT.
463 TYPE is the type of selection data requested.
464 DATA and SIZE describe the data to send, already converted.
465 FORMAT is the unit-size (in bits) of the data to be transmitted. */
468 x_reply_selection_request (event
, format
, data
, size
, type
)
469 struct input_event
*event
;
474 XSelectionEvent reply
;
475 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
476 Window window
= SELECTION_EVENT_REQUESTOR (event
);
478 int format_bytes
= format
/8;
479 int max_bytes
= SELECTION_QUANTUM (display
);
480 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
482 if (max_bytes
> MAX_SELECTION_QUANTUM
)
483 max_bytes
= MAX_SELECTION_QUANTUM
;
485 reply
.type
= SelectionNotify
;
486 reply
.display
= display
;
487 reply
.requestor
= window
;
488 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
489 reply
.time
= SELECTION_EVENT_TIME (event
);
490 reply
.target
= SELECTION_EVENT_TARGET (event
);
491 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
492 if (reply
.property
== None
)
493 reply
.property
= reply
.target
;
495 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
497 x_catch_errors (display
);
499 /* Store the data on the requested property.
500 If the selection is large, only store the first N bytes of it.
502 bytes_remaining
= size
* format_bytes
;
503 if (bytes_remaining
<= max_bytes
)
505 /* Send all the data at once, with minimal handshaking. */
507 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
509 XChangeProperty (display
, window
, reply
.property
, type
, format
,
510 PropModeReplace
, data
, size
);
511 /* At this point, the selection was successfully stored; ack it. */
512 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
516 /* Send an INCR selection. */
517 struct prop_location
*wait_object
;
520 x_start_queuing_selection_requests (display
);
522 if (x_window_to_frame (window
)) /* #### debug */
523 error ("attempt to transfer an INCR to ourself!");
525 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
527 wait_object
= expect_property_change (display
, window
, reply
.property
,
530 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
531 32, PropModeReplace
, (unsigned char *)
532 &bytes_remaining
, 1);
533 XSelectInput (display
, window
, PropertyChangeMask
);
534 /* Tell 'em the INCR data is there... */
535 (void) XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
538 had_errors
= x_had_errors_p (display
);
541 /* First, wait for the requestor to ack by deleting the property.
542 This can run random lisp code (process handlers) or signal. */
544 wait_for_property_change (wait_object
);
546 while (bytes_remaining
)
548 int i
= ((bytes_remaining
< max_bytes
)
555 = expect_property_change (display
, window
, reply
.property
,
558 fprintf (stderr
," INCR adding %d\n", i
);
560 /* Append the next chunk of data to the property. */
561 XChangeProperty (display
, window
, reply
.property
, type
, format
,
562 PropModeAppend
, data
, i
/ format_bytes
);
563 bytes_remaining
-= i
;
566 had_errors
= x_had_errors_p (display
);
572 /* Now wait for the requestor to ack this chunk by deleting the
573 property. This can run random lisp code or signal.
575 wait_for_property_change (wait_object
);
577 /* Now write a zero-length chunk to the property to tell the requestor
580 fprintf (stderr
," INCR done\n");
583 if (! waiting_for_other_props_on_window (display
, window
))
584 XSelectInput (display
, window
, 0L);
586 XChangeProperty (display
, window
, reply
.property
, type
, format
,
587 PropModeReplace
, data
, 0);
588 x_stop_queuing_selection_requests (display
);
592 x_uncatch_errors (display
);
596 /* Handle a SelectionRequest event EVENT.
597 This is called from keyboard.c when such an event is found in the queue. */
600 x_handle_selection_request (event
)
601 struct input_event
*event
;
603 struct gcpro gcpro1
, gcpro2
, gcpro3
;
604 Lisp_Object local_selection_data
;
605 Lisp_Object selection_symbol
;
606 Lisp_Object target_symbol
;
607 Lisp_Object converted_selection
;
608 Time local_selection_time
;
609 Lisp_Object successful_p
;
611 struct x_display_info
*dpyinfo
612 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
614 local_selection_data
= Qnil
;
615 target_symbol
= Qnil
;
616 converted_selection
= Qnil
;
619 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
621 selection_symbol
= x_atom_to_symbol (dpyinfo
,
622 SELECTION_EVENT_DISPLAY (event
),
623 SELECTION_EVENT_SELECTION (event
));
625 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
627 if (NILP (local_selection_data
))
629 /* Someone asked for the selection, but we don't have it any more.
631 x_decline_selection_request (event
);
635 local_selection_time
= (Time
)
636 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
638 if (SELECTION_EVENT_TIME (event
) != CurrentTime
639 && local_selection_time
> SELECTION_EVENT_TIME (event
))
641 /* Someone asked for the selection, and we have one, but not the one
644 x_decline_selection_request (event
);
648 count
= specpdl_ptr
- specpdl
;
649 x_selection_current_request
= event
;
650 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
652 target_symbol
= x_atom_to_symbol (dpyinfo
, SELECTION_EVENT_DISPLAY (event
),
653 SELECTION_EVENT_TARGET (event
));
655 #if 0 /* #### MULTIPLE doesn't work yet */
656 if (EQ (target_symbol
, QMULTIPLE
))
657 target_symbol
= fetch_multiple_target (event
);
660 /* Convert lisp objects back into binary data */
663 = x_get_local_selection (selection_symbol
, target_symbol
);
665 if (! NILP (converted_selection
))
673 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
675 &data
, &type
, &size
, &format
, &nofree
);
677 x_reply_selection_request (event
, format
, data
, size
, type
);
680 /* Indicate we have successfully processed this event. */
681 x_selection_current_request
= 0;
686 unbind_to (count
, Qnil
);
692 /* Let random lisp code notice that the selection has been asked for. */
695 rest
= Vx_sent_selection_hooks
;
696 if (!EQ (rest
, Qunbound
))
697 for (; CONSP (rest
); rest
= Fcdr (rest
))
698 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
702 /* Handle a SelectionClear event EVENT, which indicates that some other
703 client cleared out our previously asserted selection.
704 This is called from keyboard.c when such an event is found in the queue. */
707 x_handle_selection_clear (event
)
708 struct input_event
*event
;
710 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
711 Atom selection
= SELECTION_EVENT_SELECTION (event
);
712 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
714 Lisp_Object selection_symbol
, local_selection_data
;
715 Time local_selection_time
;
716 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
718 selection_symbol
= x_atom_to_symbol (dpyinfo
, display
, selection
);
720 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
722 /* Well, we already believe that we don't own it, so that's just fine. */
723 if (NILP (local_selection_data
)) return;
725 local_selection_time
= (Time
)
726 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
728 /* This SelectionClear is for a selection that we no longer own, so we can
729 disregard it. (That is, we have reasserted the selection since this
730 request was generated.) */
732 if (changed_owner_time
!= CurrentTime
733 && local_selection_time
> changed_owner_time
)
736 /* Otherwise, we're really honest and truly being told to drop it.
737 Don't use Fdelq as that may QUIT;. */
739 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
740 Vselection_alist
= Fcdr (Vselection_alist
);
744 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
745 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
747 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
752 /* Let random lisp code notice that the selection has been stolen. */
756 rest
= Vx_lost_selection_hooks
;
757 if (!EQ (rest
, Qunbound
))
759 for (; CONSP (rest
); rest
= Fcdr (rest
))
760 call1 (Fcar (rest
), selection_symbol
);
761 prepare_menu_bars ();
762 redisplay_preserve_echo_area ();
767 /* Clear all selections that were made from frame F.
768 We do this when about to delete a frame. */
771 x_clear_frame_selections (f
)
777 XSETFRAME (frame
, f
);
779 /* Otherwise, we're really honest and truly being told to drop it.
780 Don't use Fdelq as that may QUIT;. */
782 while (!NILP (Vselection_alist
)
783 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
785 /* Let random Lisp code notice that the selection has been stolen. */
786 Lisp_Object hooks
, selection_symbol
;
788 hooks
= Vx_lost_selection_hooks
;
789 selection_symbol
= Fcar (Vselection_alist
);
791 if (!EQ (hooks
, Qunbound
))
793 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
794 call1 (Fcar (hooks
), selection_symbol
);
795 redisplay_preserve_echo_area ();
798 Vselection_alist
= Fcdr (Vselection_alist
);
801 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
802 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest
)->cdr
)))))))
804 /* Let random Lisp code notice that the selection has been stolen. */
805 Lisp_Object hooks
, selection_symbol
;
807 hooks
= Vx_lost_selection_hooks
;
808 selection_symbol
= Fcar (XCONS (rest
)->cdr
);
810 if (!EQ (hooks
, Qunbound
))
812 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
813 call1 (Fcar (hooks
), selection_symbol
);
814 redisplay_preserve_echo_area ();
816 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
821 /* Nonzero if any properties for DISPLAY and WINDOW
822 are on the list of what we are waiting for. */
825 waiting_for_other_props_on_window (display
, window
)
829 struct prop_location
*rest
= property_change_wait_list
;
831 if (rest
->display
== display
&& rest
->window
== window
)
838 /* Add an entry to the list of property changes we are waiting for.
839 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
840 The return value is a number that uniquely identifies
841 this awaited property change. */
843 static struct prop_location
*
844 expect_property_change (display
, window
, property
, state
)
847 Lisp_Object property
;
850 struct prop_location
*pl
851 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
852 pl
->identifier
= ++prop_location_identifier
;
853 pl
->display
= display
;
855 pl
->property
= property
;
856 pl
->desired_state
= state
;
857 pl
->next
= property_change_wait_list
;
859 property_change_wait_list
= pl
;
863 /* Delete an entry from the list of property changes we are waiting for.
864 IDENTIFIER is the number that uniquely identifies the entry. */
867 unexpect_property_change (location
)
868 struct prop_location
*location
;
870 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
873 if (rest
== location
)
876 prev
->next
= rest
->next
;
878 property_change_wait_list
= rest
->next
;
887 /* Remove the property change expectation element for IDENTIFIER. */
890 wait_for_property_change_unwind (identifierval
)
891 Lisp_Object identifierval
;
893 unexpect_property_change ((struct prop_location
*)
894 (XFASTINT (XCONS (identifierval
)->car
) << 16
895 | XFASTINT (XCONS (identifierval
)->cdr
)));
898 /* Actually wait for a property change.
899 IDENTIFIER should be the value that expect_property_change returned. */
902 wait_for_property_change (location
)
903 struct prop_location
*location
;
906 int count
= specpdl_ptr
- specpdl
;
909 tem
= Fcons (Qnil
, Qnil
);
910 XSETFASTINT (XCONS (tem
)->car
, (EMACS_UINT
)location
>> 16);
911 XSETFASTINT (XCONS (tem
)->cdr
, (EMACS_UINT
)location
& 0xffff);
913 /* Make sure to do unexpect_property_change if we quit or err. */
914 record_unwind_protect (wait_for_property_change_unwind
, tem
);
916 XCONS (property_change_reply
)->car
= Qnil
;
918 property_change_reply_object
= location
;
919 /* If the event we are waiting for arrives beyond here, it will set
920 property_change_reply, because property_change_reply_object says so. */
921 if (! location
->arrived
)
923 secs
= x_selection_timeout
/ 1000;
924 usecs
= (x_selection_timeout
% 1000) * 1000;
925 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
927 if (NILP (XCONS (property_change_reply
)->car
))
928 error ("timed out waiting for property-notify event");
931 unbind_to (count
, Qnil
);
934 /* Called from XTread_socket in response to a PropertyNotify event. */
937 x_handle_property_notify (event
)
938 XPropertyEvent
*event
;
940 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
943 if (rest
->property
== event
->atom
944 && rest
->window
== event
->window
945 && rest
->display
== event
->display
946 && rest
->desired_state
== event
->state
)
949 fprintf (stderr
, "Saw expected prop-%s on %s\n",
950 (event
->state
== PropertyDelete
? "delete" : "change"),
951 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
, event
->display
,
958 /* If this is the one wait_for_property_change is waiting for,
959 tell it to wake up. */
960 if (rest
== property_change_reply_object
)
961 XCONS (property_change_reply
)->car
= Qt
;
964 prev
->next
= rest
->next
;
966 property_change_wait_list
= rest
->next
;
974 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
975 (event
->state
== PropertyDelete
? "delete" : "change"),
976 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo
,
977 event
->display
, event
->atom
))
984 #if 0 /* #### MULTIPLE doesn't work yet */
987 fetch_multiple_target (event
)
988 XSelectionRequestEvent
*event
;
990 Display
*display
= event
->display
;
991 Window window
= event
->requestor
;
992 Atom target
= event
->target
;
993 Atom selection_atom
= event
->selection
;
998 x_get_window_property_as_lisp_data (display
, window
, target
,
999 QMULTIPLE
, selection_atom
));
1003 copy_multiple_data (obj
)
1010 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
1012 CHECK_VECTOR (obj
, 0);
1013 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1014 for (i
= 0; i
< size
; i
++)
1016 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1017 CHECK_VECTOR (vec2
, 0);
1018 if (XVECTOR (vec2
)->size
!= 2)
1019 /* ??? Confusing error message */
1020 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1021 Fcons (vec2
, Qnil
)));
1022 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1023 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1024 = XVECTOR (vec2
)->contents
[0];
1025 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1026 = XVECTOR (vec2
)->contents
[1];
1034 /* Variables for communication with x_handle_selection_notify. */
1035 static Atom reading_which_selection
;
1036 static Lisp_Object reading_selection_reply
;
1037 static Window reading_selection_window
;
1039 /* Do protocol to read selection-data from the server.
1040 Converts this to Lisp data and returns it. */
1043 x_get_foreign_selection (selection_symbol
, target_type
)
1044 Lisp_Object selection_symbol
, target_type
;
1046 Window requestor_window
= FRAME_X_WINDOW (selected_frame
);
1047 Display
*display
= FRAME_X_DISPLAY (selected_frame
);
1048 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1049 Time requestor_time
= last_event_timestamp
;
1050 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1051 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1055 if (CONSP (target_type
))
1056 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCONS (target_type
)->car
);
1058 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1061 x_catch_errors (display
);
1062 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1063 requestor_window
, requestor_time
);
1066 /* Prepare to block until the reply has been read. */
1067 reading_selection_window
= requestor_window
;
1068 reading_which_selection
= selection_atom
;
1069 XCONS (reading_selection_reply
)->car
= Qnil
;
1070 x_start_queuing_selection_requests (display
);
1073 /* This allows quits. Also, don't wait forever. */
1074 secs
= x_selection_timeout
/ 1000;
1075 usecs
= (x_selection_timeout
% 1000) * 1000;
1076 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1079 x_check_errors (display
, "Cannot get selection: %s");
1080 x_uncatch_errors (display
);
1081 x_stop_queuing_selection_requests (display
);
1084 if (NILP (XCONS (reading_selection_reply
)->car
))
1085 error ("timed out waiting for reply from selection owner");
1087 /* Otherwise, the selection is waiting for us on the requested property. */
1089 x_get_window_property_as_lisp_data (display
, requestor_window
,
1090 target_property
, target_type
,
1094 /* Subroutines of x_get_window_property_as_lisp_data */
1097 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1098 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1103 unsigned char **data_ret
;
1105 Atom
*actual_type_ret
;
1106 int *actual_format_ret
;
1107 unsigned long *actual_size_ret
;
1111 unsigned long bytes_remaining
;
1113 unsigned char *tmp_data
= 0;
1115 int buffer_size
= SELECTION_QUANTUM (display
);
1116 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1119 /* First probe the thing to find out how big it is. */
1120 result
= XGetWindowProperty (display
, window
, property
,
1121 0, 0, False
, AnyPropertyType
,
1122 actual_type_ret
, actual_format_ret
,
1124 &bytes_remaining
, &tmp_data
);
1125 if (result
!= Success
)
1132 xfree ((char *) tmp_data
);
1134 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1140 total_size
= bytes_remaining
+ 1;
1141 *data_ret
= (unsigned char *) xmalloc (total_size
);
1143 /* Now read, until weve gotten it all. */
1144 while (bytes_remaining
)
1147 int last
= bytes_remaining
;
1150 = XGetWindowProperty (display
, window
, property
,
1151 offset
/4, buffer_size
/4,
1154 actual_type_ret
, actual_format_ret
,
1155 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1157 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1159 /* If this doesn't return Success at this point, it means that
1160 some clod deleted the selection while we were in the midst of
1161 reading it. Deal with that, I guess....
1163 if (result
!= Success
) break;
1164 *actual_size_ret
*= *actual_format_ret
/ 8;
1165 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1166 offset
+= *actual_size_ret
;
1167 xfree ((char *) tmp_data
);
1172 *bytes_ret
= offset
;
1176 receive_incremental_selection (display
, window
, property
, target_type
,
1177 min_size_bytes
, data_ret
, size_bytes_ret
,
1178 type_ret
, format_ret
, size_ret
)
1182 Lisp_Object target_type
; /* for error messages only */
1183 unsigned int min_size_bytes
;
1184 unsigned char **data_ret
;
1185 int *size_bytes_ret
;
1187 unsigned long *size_ret
;
1191 struct prop_location
*wait_object
;
1192 *size_bytes_ret
= min_size_bytes
;
1193 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1195 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1198 /* At this point, we have read an INCR property.
1199 Delete the property to ack it.
1200 (But first, prepare to receive the next event in this handshake.)
1202 Now, we must loop, waiting for the sending window to put a value on
1203 that property, then reading the property, then deleting it to ack.
1204 We are done when the sender places a property of length 0.
1207 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1208 XDeleteProperty (display
, window
, property
);
1209 wait_object
= expect_property_change (display
, window
, property
,
1216 unsigned char *tmp_data
;
1218 wait_for_property_change (wait_object
);
1219 /* expect it again immediately, because x_get_window_property may
1220 .. no it wont, I dont get it.
1221 .. Ok, I get it now, the Xt code that implements INCR is broken.
1223 x_get_window_property (display
, window
, property
,
1224 &tmp_data
, &tmp_size_bytes
,
1225 type_ret
, format_ret
, size_ret
, 1);
1227 if (tmp_size_bytes
== 0) /* we're done */
1230 fprintf (stderr
, " read INCR done\n");
1232 if (! waiting_for_other_props_on_window (display
, window
))
1233 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1234 unexpect_property_change (wait_object
);
1235 if (tmp_data
) xfree (tmp_data
);
1240 XDeleteProperty (display
, window
, property
);
1241 wait_object
= expect_property_change (display
, window
, property
,
1247 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1249 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1252 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1253 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1255 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1256 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1258 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1259 offset
+= tmp_size_bytes
;
1264 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1265 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1266 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1269 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1274 Lisp_Object target_type
; /* for error messages only */
1275 Atom selection_atom
; /* for error messages only */
1279 unsigned long actual_size
;
1280 unsigned char *data
= 0;
1283 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1285 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1286 &actual_type
, &actual_format
, &actual_size
, 1);
1289 int there_is_a_selection_owner
;
1291 there_is_a_selection_owner
1292 = XGetSelectionOwner (display
, selection_atom
);
1294 while (1) /* Note debugger can no longer return, so this is obsolete */
1296 there_is_a_selection_owner
?
1297 Fcons (build_string ("selection owner couldn't convert"),
1299 ? Fcons (target_type
,
1300 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1303 : Fcons (target_type
, Qnil
))
1304 : Fcons (build_string ("no selection"),
1305 Fcons (x_atom_to_symbol (dpyinfo
, display
,
1310 if (actual_type
== dpyinfo
->Xatom_INCR
)
1312 /* That wasn't really the data, just the beginning. */
1314 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1316 XFree ((char *) data
);
1318 receive_incremental_selection (display
, window
, property
, target_type
,
1319 min_size_bytes
, &data
, &bytes
,
1320 &actual_type
, &actual_format
,
1325 XDeleteProperty (display
, window
, property
);
1329 /* It's been read. Now convert it to a lisp object in some semi-rational
1331 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1332 actual_type
, actual_format
);
1334 xfree ((char *) data
);
1338 /* These functions convert from the selection data read from the server into
1339 something that we can use from Lisp, and vice versa.
1341 Type: Format: Size: Lisp Type:
1342 ----- ------- ----- -----------
1345 ATOM 32 > 1 Vector of Symbols
1347 * 16 > 1 Vector of Integers
1348 * 32 1 if <=16 bits: Integer
1349 if > 16 bits: Cons of top16, bot16
1350 * 32 > 1 Vector of the above
1352 When converting a Lisp number to C, it is assumed to be of format 16 if
1353 it is an integer, and of format 32 if it is a cons of two integers.
1355 When converting a vector of numbers from Lisp to C, it is assumed to be
1356 of format 16 if every element in the vector is an integer, and is assumed
1357 to be of format 32 if any element is a cons of two integers.
1359 When converting an object to C, it may be of the form (SYMBOL . <data>)
1360 where SYMBOL is what we should claim that the type is. Format and
1361 representation are as above. */
1366 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1368 unsigned char *data
;
1372 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1374 if (type
== dpyinfo
->Xatom_NULL
)
1377 /* Convert any 8-bit data to a string, for compactness. */
1378 else if (format
== 8)
1379 return make_string ((char *) data
, size
);
1381 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1382 a vector of symbols.
1384 else if (type
== XA_ATOM
)
1387 if (size
== sizeof (Atom
))
1388 return x_atom_to_symbol (dpyinfo
, display
, *((Atom
*) data
));
1391 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1392 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1393 Faset (v
, i
, x_atom_to_symbol (dpyinfo
, display
,
1394 ((Atom
*) data
) [i
]));
1399 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1400 If the number is > 16 bits, convert it to a cons of integers,
1401 16 bits in each half.
1403 else if (format
== 32 && size
== sizeof (long))
1404 return long_to_cons (((unsigned long *) data
) [0]);
1405 else if (format
== 16 && size
== sizeof (short))
1406 return make_number ((int) (((unsigned short *) data
) [0]));
1408 /* Convert any other kind of data to a vector of numbers, represented
1409 as above (as an integer, or a cons of two 16 bit integers.)
1411 else if (format
== 16)
1414 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1415 for (i
= 0; i
< size
/ 4; i
++)
1417 int j
= (int) ((unsigned short *) data
) [i
];
1418 Faset (v
, i
, make_number (j
));
1425 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1426 for (i
= 0; i
< size
/ 4; i
++)
1428 unsigned long j
= ((unsigned long *) data
) [i
];
1429 Faset (v
, i
, long_to_cons (j
));
1437 lisp_data_to_selection_data (display
, obj
,
1438 data_ret
, type_ret
, size_ret
,
1439 format_ret
, nofree_ret
)
1442 unsigned char **data_ret
;
1444 unsigned int *size_ret
;
1448 Lisp_Object type
= Qnil
;
1449 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1453 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1455 type
= XCONS (obj
)->car
;
1456 obj
= XCONS (obj
)->cdr
;
1457 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1458 obj
= XCONS (obj
)->car
;
1461 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1462 { /* This is not the same as declining */
1468 else if (STRINGP (obj
))
1471 *size_ret
= XSTRING (obj
)->size
;
1472 *data_ret
= XSTRING (obj
)->data
;
1474 if (NILP (type
)) type
= QSTRING
;
1476 else if (SYMBOLP (obj
))
1480 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1481 (*data_ret
) [sizeof (Atom
)] = 0;
1482 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1483 if (NILP (type
)) type
= QATOM
;
1485 else if (INTEGERP (obj
)
1486 && XINT (obj
) < 0xFFFF
1487 && XINT (obj
) > -0xFFFF)
1491 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1492 (*data_ret
) [sizeof (short)] = 0;
1493 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1494 if (NILP (type
)) type
= QINTEGER
;
1496 else if (INTEGERP (obj
)
1497 || (CONSP (obj
) && INTEGERP (XCONS (obj
)->car
)
1498 && (INTEGERP (XCONS (obj
)->cdr
)
1499 || (CONSP (XCONS (obj
)->cdr
)
1500 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)))))
1504 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1505 (*data_ret
) [sizeof (long)] = 0;
1506 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1507 if (NILP (type
)) type
= QINTEGER
;
1509 else if (VECTORP (obj
))
1511 /* Lisp_Vectors may represent a set of ATOMs;
1512 a set of 16 or 32 bit INTEGERs;
1513 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1517 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1518 /* This vector is an ATOM set */
1520 if (NILP (type
)) type
= QATOM
;
1521 *size_ret
= XVECTOR (obj
)->size
;
1523 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1524 for (i
= 0; i
< *size_ret
; i
++)
1525 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1526 (*(Atom
**) data_ret
) [i
]
1527 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1529 Fsignal (Qerror
, /* Qselection_error */
1531 ("all elements of selection vector must have same type"),
1532 Fcons (obj
, Qnil
)));
1534 #if 0 /* #### MULTIPLE doesn't work yet */
1535 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1536 /* This vector is an ATOM_PAIR set */
1538 if (NILP (type
)) type
= QATOM_PAIR
;
1539 *size_ret
= XVECTOR (obj
)->size
;
1541 *data_ret
= (unsigned char *)
1542 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1543 for (i
= 0; i
< *size_ret
; i
++)
1544 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1546 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1547 if (XVECTOR (pair
)->size
!= 2)
1550 ("elements of the vector must be vectors of exactly two elements"),
1551 Fcons (pair
, Qnil
)));
1553 (*(Atom
**) data_ret
) [i
* 2]
1554 = symbol_to_x_atom (dpyinfo
, display
,
1555 XVECTOR (pair
)->contents
[0]);
1556 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1557 = symbol_to_x_atom (dpyinfo
, display
,
1558 XVECTOR (pair
)->contents
[1]);
1563 ("all elements of the vector must be of the same type"),
1564 Fcons (obj
, Qnil
)));
1569 /* This vector is an INTEGER set, or something like it */
1571 *size_ret
= XVECTOR (obj
)->size
;
1572 if (NILP (type
)) type
= QINTEGER
;
1574 for (i
= 0; i
< *size_ret
; i
++)
1575 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1577 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1578 Fsignal (Qerror
, /* Qselection_error */
1580 ("elements of selection vector must be integers or conses of integers"),
1581 Fcons (obj
, Qnil
)));
1583 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1584 for (i
= 0; i
< *size_ret
; i
++)
1585 if (*format_ret
== 32)
1586 (*((unsigned long **) data_ret
)) [i
]
1587 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1589 (*((unsigned short **) data_ret
)) [i
]
1590 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1594 Fsignal (Qerror
, /* Qselection_error */
1595 Fcons (build_string ("unrecognised selection data"),
1596 Fcons (obj
, Qnil
)));
1598 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1602 clean_local_selection_data (obj
)
1606 && INTEGERP (XCONS (obj
)->car
)
1607 && CONSP (XCONS (obj
)->cdr
)
1608 && INTEGERP (XCONS (XCONS (obj
)->cdr
)->car
)
1609 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1610 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1613 && INTEGERP (XCONS (obj
)->car
)
1614 && INTEGERP (XCONS (obj
)->cdr
))
1616 if (XINT (XCONS (obj
)->car
) == 0)
1617 return XCONS (obj
)->cdr
;
1618 if (XINT (XCONS (obj
)->car
) == -1)
1619 return make_number (- XINT (XCONS (obj
)->cdr
));
1624 int size
= XVECTOR (obj
)->size
;
1627 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1628 copy
= Fmake_vector (size
, Qnil
);
1629 for (i
= 0; i
< size
; i
++)
1630 XVECTOR (copy
)->contents
[i
]
1631 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1637 /* Called from XTread_socket to handle SelectionNotify events.
1638 If it's the selection we are waiting for, stop waiting. */
1641 x_handle_selection_notify (event
)
1642 XSelectionEvent
*event
;
1644 if (event
->requestor
!= reading_selection_window
)
1646 if (event
->selection
!= reading_which_selection
)
1649 XCONS (reading_selection_reply
)->car
= Qt
;
1653 DEFUN ("x-own-selection-internal",
1654 Fx_own_selection_internal
, Sx_own_selection_internal
,
1656 "Assert an X selection of the given TYPE with the given VALUE.\n\
1657 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1658 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1659 VALUE is typically a string, or a cons of two markers, but may be\n\
1660 anything that the functions on `selection-converter-alist' know about.")
1661 (selection_name
, selection_value
)
1662 Lisp_Object selection_name
, selection_value
;
1665 CHECK_SYMBOL (selection_name
, 0);
1666 if (NILP (selection_value
)) error ("selection-value may not be nil.");
1667 x_own_selection (selection_name
, selection_value
);
1668 return selection_value
;
1672 /* Request the selection value from the owner. If we are the owner,
1673 simply return our selection value. If we are not the owner, this
1674 will block until all of the data has arrived. */
1676 DEFUN ("x-get-selection-internal",
1677 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1678 "Return text selected from some X window.\n\
1679 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1680 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1681 TYPE is the type of data desired, typically `STRING'.")
1682 (selection_symbol
, target_type
)
1683 Lisp_Object selection_symbol
, target_type
;
1685 Lisp_Object val
= Qnil
;
1686 struct gcpro gcpro1
, gcpro2
;
1687 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1689 CHECK_SYMBOL (selection_symbol
, 0);
1691 #if 0 /* #### MULTIPLE doesn't work yet */
1692 if (CONSP (target_type
)
1693 && XCONS (target_type
)->car
== QMULTIPLE
)
1695 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1696 /* So we don't destructively modify this... */
1697 target_type
= copy_multiple_data (target_type
);
1701 CHECK_SYMBOL (target_type
, 0);
1703 val
= x_get_local_selection (selection_symbol
, target_type
);
1707 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1712 && SYMBOLP (XCONS (val
)->car
))
1714 val
= XCONS (val
)->cdr
;
1715 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1716 val
= XCONS (val
)->car
;
1718 val
= clean_local_selection_data (val
);
1724 DEFUN ("x-disown-selection-internal",
1725 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1726 "If we own the selection SELECTION, disown it.\n\
1727 Disowning it means there is no such selection.")
1729 Lisp_Object selection
;
1733 Atom selection_atom
;
1734 XSelectionClearEvent event
;
1736 struct x_display_info
*dpyinfo
;
1739 display
= FRAME_X_DISPLAY (selected_frame
);
1740 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1741 CHECK_SYMBOL (selection
, 0);
1743 timestamp
= last_event_timestamp
;
1745 timestamp
= cons_to_long (time
);
1747 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1748 return Qnil
; /* Don't disown the selection when we're not the owner. */
1750 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
1753 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1756 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1757 generated for a window which owns the selection when that window sets
1758 the selection owner to None. The NCD server does, the MIT Sun4 server
1759 doesn't. So we synthesize one; this means we might get two, but
1760 that's ok, because the second one won't have any effect. */
1761 SELECTION_EVENT_DISPLAY (&event
) = display
;
1762 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
1763 SELECTION_EVENT_TIME (&event
) = timestamp
;
1764 x_handle_selection_clear (&event
);
1769 /* Get rid of all the selections in buffer BUFFER.
1770 This is used when we kill a buffer. */
1773 x_disown_buffer_selections (buffer
)
1777 struct buffer
*buf
= XBUFFER (buffer
);
1779 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCONS (tail
)->cdr
)
1781 Lisp_Object elt
, value
;
1782 elt
= XCONS (tail
)->car
;
1783 value
= XCONS (elt
)->cdr
;
1784 if (CONSP (value
) && MARKERP (XCONS (value
)->car
)
1785 && XMARKER (XCONS (value
)->car
)->buffer
== buf
)
1786 Fx_disown_selection_internal (XCONS (elt
)->car
, Qnil
);
1790 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1792 "Whether the current Emacs process owns the given X Selection.\n\
1793 The arg should be the name of the selection in question, typically one of\n\
1794 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1795 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1796 For convenience, the symbol nil is the same as `PRIMARY',\n\
1797 and t is the same as `SECONDARY'.)")
1799 Lisp_Object selection
;
1802 CHECK_SYMBOL (selection
, 0);
1803 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1804 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1806 if (NILP (Fassq (selection
, Vselection_alist
)))
1811 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1813 "Whether there is an owner for the given X Selection.\n\
1814 The arg should be the name of the selection in question, typically one of\n\
1815 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1816 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1817 For convenience, the symbol nil is the same as `PRIMARY',\n\
1818 and t is the same as `SECONDARY'.)")
1820 Lisp_Object selection
;
1826 /* It should be safe to call this before we have an X frame. */
1827 if (! FRAME_X_P (selected_frame
))
1830 dpy
= FRAME_X_DISPLAY (selected_frame
);
1831 CHECK_SYMBOL (selection
, 0);
1832 if (!NILP (Fx_selection_owner_p (selection
)))
1834 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1835 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1836 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1841 owner
= XGetSelectionOwner (dpy
, atom
);
1843 return (owner
? Qt
: Qnil
);
1847 #ifdef CUT_BUFFER_SUPPORT
1849 static int cut_buffers_initialized
; /* Whether we're sure they all exist */
1851 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1853 initialize_cut_buffers (display
, window
)
1857 unsigned char *data
= (unsigned char *) "";
1859 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1860 PropModeAppend, data, 0)
1861 FROB (XA_CUT_BUFFER0
);
1862 FROB (XA_CUT_BUFFER1
);
1863 FROB (XA_CUT_BUFFER2
);
1864 FROB (XA_CUT_BUFFER3
);
1865 FROB (XA_CUT_BUFFER4
);
1866 FROB (XA_CUT_BUFFER5
);
1867 FROB (XA_CUT_BUFFER6
);
1868 FROB (XA_CUT_BUFFER7
);
1871 cut_buffers_initialized
= 1;
1875 #define CHECK_CUT_BUFFER(symbol,n) \
1876 { CHECK_SYMBOL ((symbol), (n)); \
1877 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1878 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1879 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1880 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1882 Fcons (build_string ("doesn't name a cut buffer"), \
1883 Fcons ((symbol), Qnil))); \
1886 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
1887 Sx_get_cut_buffer_internal
, 1, 1, 0,
1888 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1894 unsigned char *data
;
1901 struct x_display_info
*dpyinfo
;
1904 display
= FRAME_X_DISPLAY (selected_frame
);
1905 dpyinfo
= FRAME_X_DISPLAY_INFO (selected_frame
);
1906 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1907 CHECK_CUT_BUFFER (buffer
, 0);
1908 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
1910 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1911 &type
, &format
, &size
, 0);
1912 if (!data
) return Qnil
;
1914 if (format
!= 8 || type
!= XA_STRING
)
1916 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1917 Fcons (x_atom_to_symbol (dpyinfo
, display
, type
),
1918 Fcons (make_number (format
), Qnil
))));
1920 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1926 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
1927 Sx_store_cut_buffer_internal
, 2, 2, 0,
1928 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1930 Lisp_Object buffer
, string
;
1934 unsigned char *data
;
1936 int bytes_remaining
;
1941 display
= FRAME_X_DISPLAY (selected_frame
);
1942 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1944 max_bytes
= SELECTION_QUANTUM (display
);
1945 if (max_bytes
> MAX_SELECTION_QUANTUM
)
1946 max_bytes
= MAX_SELECTION_QUANTUM
;
1948 CHECK_CUT_BUFFER (buffer
, 0);
1949 CHECK_STRING (string
, 0);
1950 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame
),
1952 data
= (unsigned char *) XSTRING (string
)->data
;
1953 bytes
= XSTRING (string
)->size
;
1954 bytes_remaining
= bytes
;
1956 if (! cut_buffers_initialized
) initialize_cut_buffers (display
, window
);
1960 /* Don't mess up with an empty value. */
1961 if (!bytes_remaining
)
1962 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1963 PropModeReplace
, data
, 0);
1965 while (bytes_remaining
)
1967 int chunk
= (bytes_remaining
< max_bytes
1968 ? bytes_remaining
: max_bytes
);
1969 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1970 (bytes_remaining
== bytes
1975 bytes_remaining
-= chunk
;
1982 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
1983 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
1984 "Rotate the values of the cut buffers by the given number of steps;\n\
1985 positive means move values forward, negative means backward.")
1994 display
= FRAME_X_DISPLAY (selected_frame
);
1995 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
1996 CHECK_NUMBER (n
, 0);
1999 if (! cut_buffers_initialized
)
2000 initialize_cut_buffers (display
, window
);
2002 props
[0] = XA_CUT_BUFFER0
;
2003 props
[1] = XA_CUT_BUFFER1
;
2004 props
[2] = XA_CUT_BUFFER2
;
2005 props
[3] = XA_CUT_BUFFER3
;
2006 props
[4] = XA_CUT_BUFFER4
;
2007 props
[5] = XA_CUT_BUFFER5
;
2008 props
[6] = XA_CUT_BUFFER6
;
2009 props
[7] = XA_CUT_BUFFER7
;
2011 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2021 defsubr (&Sx_get_selection_internal
);
2022 defsubr (&Sx_own_selection_internal
);
2023 defsubr (&Sx_disown_selection_internal
);
2024 defsubr (&Sx_selection_owner_p
);
2025 defsubr (&Sx_selection_exists_p
);
2027 #ifdef CUT_BUFFER_SUPPORT
2028 defsubr (&Sx_get_cut_buffer_internal
);
2029 defsubr (&Sx_store_cut_buffer_internal
);
2030 defsubr (&Sx_rotate_cut_buffers_internal
);
2031 cut_buffers_initialized
= 0;
2034 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2035 staticpro (&reading_selection_reply
);
2036 reading_selection_window
= 0;
2037 reading_which_selection
= 0;
2039 property_change_wait_list
= 0;
2040 prop_location_identifier
= 0;
2041 property_change_reply
= Fcons (Qnil
, Qnil
);
2042 staticpro (&property_change_reply
);
2044 Vselection_alist
= Qnil
;
2045 staticpro (&Vselection_alist
);
2047 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2048 "An alist associating X Windows selection-types with functions.\n\
2049 These functions are called to convert the selection, with three args:\n\
2050 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2051 a desired type to which the selection should be converted;\n\
2052 and the local selection value (whatever was given to `x-own-selection').\n\
2054 The function should return the value to send to the X server\n\
2055 \(typically a string). A return value of nil\n\
2056 means that the conversion could not be done.\n\
2057 A return value which is the symbol `NULL'\n\
2058 means that a side-effect was executed,\n\
2059 and there is no meaningful selection value.");
2060 Vselection_converter_alist
= Qnil
;
2062 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2063 "A list of functions to be called when Emacs loses an X selection.\n\
2064 \(This happens when some other X client makes its own selection\n\
2065 or when a Lisp program explicitly clears the selection.)\n\
2066 The functions are called with one argument, the selection type\n\
2067 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
2068 Vx_lost_selection_hooks
= Qnil
;
2070 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2071 "A list of functions to be called when Emacs answers a selection request.\n\
2072 The functions are called with four arguments:\n\
2073 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2074 - the selection-type which Emacs was asked to convert the\n\
2075 selection into before sending (for example, `STRING' or `LENGTH');\n\
2076 - a flag indicating success or failure for responding to the request.\n\
2077 We might have failed (and declined the request) for any number of reasons,\n\
2078 including being asked for a selection that we no longer own, or being asked\n\
2079 to convert into a type that we don't know about or that is inappropriate.\n\
2080 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2081 it merely informs you that they have happened.");
2082 Vx_sent_selection_hooks
= Qnil
;
2084 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2085 "Number of milliseconds to wait for a selection reply.\n\
2086 If the selection owner doens't reply in this time, we give up.\n\
2087 A value of 0 means wait as long as necessary. This is initialized from the\n\
2088 \"*selectionTimeout\" resource.");
2089 x_selection_timeout
= 0;
2091 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2092 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2093 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2094 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2095 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2096 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2097 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2098 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2099 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2100 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2101 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2102 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2103 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2104 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2105 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2106 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2108 #ifdef CUT_BUFFER_SUPPORT
2109 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2110 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2111 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2112 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2113 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2114 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2115 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2116 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);