1 /* x_handle_selection_notify
2 x_reply_selection_request
4 x_selection_timeout initial value */
6 /* X Selection processing for emacs
7 Copyright (C) 1990-1993 Free Software Foundation.
9 This file is part of GNU Emacs.
11 GNU Emacs is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 2, or (at your option)
16 GNU Emacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs; see the file COPYING. If not, write to
23 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
25 /* Rewritten by jwz */
29 #include "xterm.h" /* for all of the X includes */
30 #include "dispextern.h" /* screen.h seems to want this */
31 #include "screen.h" /* Need this to get the X window of selected_screen */
33 #define CUT_BUFFER_SUPPORT
35 static Atom Xatom_CLIPBOARD
, Xatom_TIMESTAMP
, Xatom_TEXT
, Xatom_DELETE
,
36 Xatom_MULTIPLE
, Xatom_INCR
, Xatom_EMACS_TMP
, Xatom_TARGETS
, Xatom_NULL
,
39 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
40 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
43 #ifdef CUT_BUFFER_SUPPORT
44 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
45 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
48 Lisp_Object Vx_lost_selection_hooks
;
49 Lisp_Object Vx_sent_selection_hooks
;
51 /* If this is a smaller number than the max-request-size of the display,
52 emacs will use INCR selection transfer when the selection is larger
53 than this. The max-request-size is usually around 64k, so if you want
54 emacs to use incremental selection transfers when the selection is
55 smaller than that, set this. I added this mostly for debugging the
56 incremental transfer stuff, but it might improve server performance.
58 #define MAX_SELECTION_QUANTUM 0xFFFFFF
60 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
63 /* The time of the last-read mouse or keyboard event.
64 For selection purposes, we use this as a sleazy way of knowing what the
65 current time is in server-time. This assumes that the most recently read
66 mouse or keyboard event has something to do with the assertion of the
67 selection, which is probably true.
69 extern Time mouse_timestamp
;
72 /* This is an association list whose elements are of the form
73 ( selection-name selection-value selection-timestamp )
74 selection-name is a lisp symbol, whose name is the name of an X Atom.
75 selection-value is the value that emacs owns for that selection.
76 It may be any kind of Lisp object.
77 selection-timestamp is the time at which emacs began owning this selection,
78 as a cons of two 16-bit numbers (making a 32 bit time.)
79 If there is an entry in this alist, then it can be assumed that emacs owns
81 The only (eq) parts of this list that are visible from Lisp are the
84 Lisp_Object Vselection_alist
;
86 /* This is an alist whose CARs are selection-types (whose names are the same
87 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
88 call to convert the given Emacs selection value to a string representing
89 the given selection type. This is for Lisp-level extension of the emacs
92 Lisp_Object Vselection_converter_alist
;
94 /* If the selection owner takes too long to reply to a selection request,
95 we give up on it. This is in seconds (0 = no timeout.)
97 int x_selection_timeout
;
100 /* Utility functions */
102 static void lisp_data_to_selection_data ();
103 static Lisp_Object
selection_data_to_lisp_data ();
104 static Lisp_Object
x_get_window_property_as_lisp_data ();
106 static int expect_property_change ();
107 static void wait_for_property_change ();
108 static void unexpect_property_change ();
109 static int waiting_for_other_props_on_window ();
111 /* This converts a Lisp symbol to a server Atom, avoiding a server
112 roundtrip whenever possible. */
115 symbol_to_x_atom (display
, sym
)
120 if (NILP (sym
)) return 0;
121 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
122 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
123 if (EQ (sym
, QSTRING
)) return XA_STRING
;
124 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
125 if (EQ (sym
, QATOM
)) return XA_ATOM
;
126 if (EQ (sym
, QCLIPBOARD
)) return Xatom_CLIPBOARD
;
127 if (EQ (sym
, QTIMESTAMP
)) return Xatom_TIMESTAMP
;
128 if (EQ (sym
, QTEXT
)) return Xatom_TEXT
;
129 if (EQ (sym
, QDELETE
)) return Xatom_DELETE
;
130 if (EQ (sym
, QMULTIPLE
)) return Xatom_MULTIPLE
;
131 if (EQ (sym
, QINCR
)) return Xatom_INCR
;
132 if (EQ (sym
, QEMACS_TMP
)) return Xatom_EMACS_TMP
;
133 if (EQ (sym
, QTARGETS
)) return Xatom_TARGETS
;
134 if (EQ (sym
, QNULL
)) return Xatom_NULL
;
135 #ifdef CUT_BUFFER_SUPPORT
136 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
137 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
138 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
139 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
140 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
141 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
142 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
143 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
145 if (!SYMBOLP (sym
)) abort ();
148 fprintf (stderr
, " XInternAtom %s\n", (char *) XSYMBOL (sym
)->name
->data
);
151 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
157 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
158 and calls to intern whenever possible. */
161 x_atom_to_symbol (display
, atom
)
167 if (! atom
) return Qnil
;
178 case Xatom_CLIPBOARD
:
180 case Xatom_TIMESTAMP
:
190 case Xatom_EMACS_TMP
:
196 #ifdef CUT_BUFFER_SUPPORT
216 str
= XGetAtomName (display
, atom
);
219 fprintf (stderr
, " XGetAtomName --> %s\n", str
);
221 if (! str
) return Qnil
;
234 unsigned int top
= i
>> 16;
235 unsigned int bot
= i
& 0xFFFF;
236 if (top
== 0) return make_number (bot
);
237 if (top
== 0xFFFF) return Fcons (make_number (-1), make_number (bot
));
238 return Fcons (make_number (top
), make_number (bot
));
246 if (FIXNUMP (c
)) return XINT (c
);
247 top
= XCONS (c
)->car
;
248 bot
= XCONS (c
)->cdr
;
249 if (CONSP (bot
)) bot
= XCONS (bot
)->car
;
250 return ((XINT (top
) << 16) | XINT (bot
));
255 /* Do protocol to assert ourself as a selection owner.
256 Update the Vselection_alist so that we can reply to later requests for
260 x_own_selection (selection_name
, selection_value
)
261 Lisp_Object selection_name
, selection_value
;
263 Display
*display
= x_current_display
;
265 Window selecting_window
= XtWindow (selected_screen
->display
.x
->edit_widget
);
267 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
269 Time time
= mouse_timestamp
;
272 CHECK_SYMBOL (selection_name
, 0);
273 selection_atom
= symbol_to_x_atom (display
, selection_name
);
276 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
279 /* Now update the local cache */
281 Lisp_Object selection_time
;
282 Lisp_Object selection_data
;
283 Lisp_Object prev_value
;
285 selection_time
= long_to_cons ((unsigned long) time
);
286 selection_data
= Fcons (selection_name
,
287 Fcons (selection_value
,
288 Fcons (selection_time
, Qnil
)));
289 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
291 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
293 /* If we already owned the selection, remove the old selection data.
294 Perhaps we should destructively modify it instead.
295 Don't use Fdelq as that may QUIT. */
296 if (!NILP (prev_value
))
298 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
299 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
300 if (EQ (prev_value
, Fcar (XCONS (rest
)->cdr
)))
302 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
309 /* Given a selection-name and desired type, look up our local copy of
310 the selection value and convert it to the type.
311 The value is nil or a string.
312 This function is used both for remote requests
313 and for local x-get-selection-internal. */
315 This calls random Lisp code
, and may signal
or gc
. */
318 x_get_local_selection (selection_symbol
, target_type
)
319 Lisp_Object selection_symbol
, target_type
;
321 Lisp_Object local_value
;
322 Lisp_Object handler_fn
, value
, type
, check
;
325 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
327 if (NILP (local_value
)) return Qnil
;
329 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
330 if (EQ (target_type
, QTIMESTAMP
))
333 value
= XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
;
336 else if (EQ (target_type
, QDELETE
))
339 Fx_disown_selection_internal
341 XCONS (XCONS (XCONS (local_value
)->cdr
)->cdr
)->car
);
346 #if 0 /* #### MULTIPLE doesn't work yet */
347 else if (CONSP (target_type
)
348 && XCONS (target_type
)->car
== QMULTIPLE
)
350 Lisp_Object pairs
= XCONS (target_type
)->cdr
;
351 int size
= XVECTOR (pairs
)->size
;
353 /* If the target is MULTIPLE, then target_type looks like
354 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
355 We modify the second element of each pair in the vector and
356 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
358 for (i
= 0; i
< size
; i
++)
360 Lisp_Object pair
= XVECTOR (pairs
)->contents
[i
];
361 XVECTOR (pair
)->contents
[1]
362 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
363 XVECTOR (pair
)->contents
[1]);
370 /* Don't allow a quit within the converter.
371 When the user types C-g, he would be surprised
372 if by luck it came during a converter. */
373 count
= specpdl_ptr
- specpdl
;
374 specbind (Qinhibit_quit
, Qt
);
376 CHECK_SYMBOL (target_type
, 0);
377 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
378 if (NILP (handler_fn
)) return Qnil
;
379 value
= call3 (handler_fn
,
380 selection_symbol
, target_type
,
381 XCONS (XCONS (local_value
)->cdr
)->car
);
382 unbind_to (count
, Qnil
);
385 /* Make sure this value is of a type that we could transmit
386 to another X client. */
389 && SYMBOLP (XCONS (value
)->car
))
390 type
= XCONS (value
)->car
,
391 check
= XCONS (value
)->cdr
;
399 else if (CONSP (check
)
400 && FIXNUMP (XCONS (check
)->car
)
401 && (FIXNUMP (XCONS (check
)->cdr
)
403 (CONSP (XCONS (check
)->cdr
)
404 && FIXNUMP (XCONS (XCONS (check
)->cdr
)->car
)
405 && NILP (XCONS (XCONS (check
)->cdr
)->cdr
))))
410 Fcons (build_string ("unrecognised selection-conversion type"),
411 Fcons (handler_fn
, Fcons (value
, Qnil
))));
414 /* Subroutines of x_reply_selection_request. */
416 /* Send a SelectionNotify event to the requestor with property=None,
417 meaning we were unable to do what they wanted. */
420 x_decline_selection_request (event
)
421 struct input_event
*event
;
423 XSelectionEvent reply
;
424 reply
.type
= SelectionNotify
;
425 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
426 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
427 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
428 reply
.time
= SELECTION_EVENT_TIME (event
);
429 reply
.target
= SELECTION_EVENT_TARGET (event
);
430 reply
.property
= None
;
433 (void) XSendEvent (reply
.display
, reply
.requestor
, False
, 0L,
438 /* This is the selection request currently being processed.
439 It is set to zero when the request is fully processed. */
440 static struct input_event
*x_selection_current_request
;
442 /* Used as an unwind-protect clause so that, if a selection-converter signals
443 an error, we tell the requestor that we were unable to do what they wanted
444 before we throw to top-level or go into the debugger or whatever. */
447 x_selection_request_lisp_error (ignore
)
450 if (x_selection_current_request
!= 0)
451 x_decline_selection_request (x_selection_current_request
);
455 /* Send the reply to a selection request event EVENT.
456 TYPE is the type of selection data requested.
457 DATA and SIZE describe the data to send, already converted.
458 FORMAT is the unit-size (in bits) of the data to be transmitted. */
461 x_reply_selection_request (event
, format
, data
, size
, type
)
462 struct input_event
*event
;
467 XSelectionEvent reply
;
468 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
469 Window window
= SELECTION_EVENT_REQUESTOR (event
);
471 int format_bytes
= format
/8;
472 int max_bytes
= SELECTION_QUANTUM (display
);
474 if (max_bytes
> MAX_SELECTION_QUANTUM
)
475 max_bytes
= MAX_SELECTION_QUANTUM
;
477 reply
.type
= SelectionNotify
;
478 reply
.display
= display
;
479 reply
.requestor
= window
;
480 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
481 reply
.time
= SELECTION_EVENT_TIME (event
);
482 reply
.target
= SELECTION_EVENT_TARGET (event
);
483 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
484 if (reply
.property
== None
)
485 reply
.property
= reply
.target
;
487 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
490 /* Store the data on the requested property.
491 If the selection is large, only store the first N bytes of it.
493 bytes_remaining
= size
* format_bytes
;
494 if (bytes_remaining
<= max_bytes
)
496 /* Send all the data at once, with minimal handshaking. */
498 fprintf (stderr
,"\nStoring all %d\n", bytes_remaining
);
500 XChangeProperty (display
, window
, reply
.property
, type
, format
,
501 PropModeReplace
, data
, size
);
502 /* At this point, the selection was successfully stored; ack it. */
503 (void) XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
507 /* Send an INCR selection. */
510 if (x_window_to_screen (window
)) /* #### debug */
511 error ("attempt to transfer an INCR to ourself!");
513 fprintf (stderr
, "\nINCR %d\n", bytes_remaining
);
515 prop_id
= expect_property_change (display
, window
, reply
.property
,
518 XChangeProperty (display
, window
, reply
.property
, Xatom_INCR
,
519 32, PropModeReplace
, (unsigned char *)
520 &bytes_remaining
, 1);
521 XSelectInput (display
, window
, PropertyChangeMask
);
522 /* Tell 'em the INCR data is there... */
523 (void) XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
525 /* First, wait for the requestor to ack by deleting the property.
526 This can run random lisp code (process handlers) or signal. */
527 wait_for_property_change (prop_id
);
529 while (bytes_remaining
)
531 int i
= ((bytes_remaining
< max_bytes
)
534 prop_id
= expect_property_change (display
, window
, reply
.property
,
537 fprintf (stderr
," INCR adding %d\n", i
);
539 /* Append the next chunk of data to the property. */
540 XChangeProperty (display
, window
, reply
.property
, type
, format
,
541 PropModeAppend
, data
, i
/ format_bytes
);
542 bytes_remaining
-= i
;
545 /* Now wait for the requestor to ack this chunk by deleting the
546 property. This can run random lisp code or signal.
548 wait_for_property_change (prop_id
);
550 /* Now write a zero-length chunk to the property to tell the requestor
553 fprintf (stderr
," INCR done\n");
555 if (! waiting_for_other_props_on_window (display
, window
))
556 XSelectInput (display
, window
, 0L);
558 XChangeProperty (display
, window
, reply
.property
, type
, format
,
559 PropModeReplace
, data
, 0);
564 /* Handle a SelectionRequest event EVENT.
565 This is called from keyboard.c when such an event is found in the queue. */
568 x_handle_selection_request (event
)
569 struct input_event
*event
;
571 struct gcpro gcpro1
, gcpro2
, gcpro3
;
572 XSelectionEvent reply
;
573 Lisp_Object local_selection_data
= Qnil
;
574 Lisp_Object selection_symbol
;
575 Lisp_Object target_symbol
= Qnil
;
576 Lisp_Object converted_selection
= Qnil
;
577 Time local_selection_time
;
578 Lisp_Object successful_p
= Qnil
;
581 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
583 reply
.type
= SelectionNotify
; /* Construct the reply event */
584 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
585 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
586 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
587 reply
.time
= SELECTION_EVENT_TIME (event
);
588 reply
.target
= SELECTION_EVENT_TARGET (event
);
589 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
590 if (reply
.property
== None
)
591 reply
.property
= reply
.target
;
593 selection_symbol
= x_atom_to_symbol (reply
.display
,
594 SELECTION_EVENT_SELECTION (event
));
596 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
599 # define CDR(x) (XCONS (x)->cdr)
600 # define CAR(x) (XCONS (x)->car)
601 /* This list isn't user-visible, so it can't "go bad." */
602 if (!CONSP (local_selection_data
)) abort ();
603 if (!CONSP (CDR (local_selection_data
))) abort ();
604 if (!CONSP (CDR (CDR (local_selection_data
)))) abort ();
605 if (!NILP (CDR (CDR (CDR (local_selection_data
))))) abort ();
606 if (!CONSP (CAR (CDR (CDR (local_selection_data
))))) abort ();
607 if (!FIXNUMP (CAR (CAR (CDR (CDR (local_selection_data
)))))) abort ();
608 if (!FIXNUMP (CDR (CAR (CDR (CDR (local_selection_data
)))))) abort ();
613 if (NILP (local_selection_data
))
615 /* Someone asked for the selection, but we don't have it any more.
617 x_decline_selection_request (event
);
621 local_selection_time
= (Time
)
622 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
624 if (SELECTION_EVENT_TIME (event
) != CurrentTime
625 && local_selection_time
> event
->time
)
627 /* Someone asked for the selection, and we have one, but not the one
630 x_decline_selection_request (event
);
634 count
= specpdl_ptr
- specpdl
;
635 x_selection_current_request
= event
;
636 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
638 target_symbol
= x_atom_to_symbol (reply
.display
,
639 SELECTION_EVENT_TARGET (event
));
641 #if 0 /* #### MULTIPLE doesn't work yet */
642 if (EQ (target_symbol
, QMULTIPLE
))
643 target_symbol
= fetch_multiple_target (event
);
646 /* Convert lisp objects back into binary data */
649 = x_get_local_selection (selection_symbol
, target_symbol
);
651 if (! NILP (converted_selection
))
657 lisp_data_to_selection_data (reply
.display
, converted_selection
,
658 &data
, &type
, &size
, &format
);
660 x_reply_selection_request (event
, format
, data
, size
, type
);
663 /* Indicate we have successfully processed this event. */
664 x_selection_current_event
= 0;
668 unbind_to (count
, Qnil
);
674 /* Let random lisp code notice that the selection has been asked for. */
676 Lisp_Object rest
= Vx_sent_selection_hooks
;
677 if (!EQ (rest
, Qunbound
))
678 for (; CONSP (rest
); rest
= Fcdr (rest
))
679 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
683 /* Handle a SelectionClear event EVENT, which indicates that some other
684 client cleared out our previously asserted selection.
685 This is called from keyboard.c when such an event is found in the queue. */
688 x_handle_selection_clear (event
)
689 struct input_event
*event
;
691 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
692 Atom selection
= SELECTION_EVENT_SELECTION (event
);
693 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
695 Lisp_Object selection_symbol
, local_selection_data
;
696 Time local_selection_time
;
698 selection_symbol
= x_atom_to_symbol (display
, selection
);
700 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
702 /* Well, we already believe that we don't own it, so that's just fine. */
703 if (NILP (local_selection_data
)) return;
705 local_selection_time
= (Time
)
706 cons_to_long (XCONS (XCONS (XCONS (local_selection_data
)->cdr
)->cdr
)->car
);
708 /* This SelectionClear is for a selection that we no longer own, so we can
709 disregard it. (That is, we have reasserted the selection since this
710 request was generated.) */
712 if (changed_owner_time
!= CurrentTime
713 && local_selection_time
> changed_owner_time
)
716 /* Otherwise, we're really honest and truly being told to drop it.
717 Don't use Fdelq as that may QUIT;. */
719 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
720 Vselection_alist
= Fcdr (Vselection_alist
);
724 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
725 if (EQ (local_selection_data
, Fcar (XCONS (rest
)->cdr
)))
727 XCONS (rest
)->cdr
= Fcdr (XCONS (rest
)->cdr
);
732 /* Let random lisp code notice that the selection has been stolen. */
735 Lisp_Object rest
= Vx_lost_selection_hooks
;
736 if (!EQ (rest
, Qunbound
))
737 for (; CONSP (rest
); rest
= Fcdr (rest
))
738 call1 (Fcar (rest
), selection_symbol
);
743 /* This stuff is so that INCR selections are reentrant (that is, so we can
744 be servicing multiple INCR selection requests simultaneously.) I haven't
745 actually tested that yet. */
747 static int prop_location_tick
;
749 static Lisp_Object property_change_reply
;
750 static int property_change_reply_tick
;
752 /* Keep a list of the property changes that are awaited. */
761 struct prop_location
*next
;
764 static struct prop_location
*property_change_wait_list
;
767 property_deleted_p (tick
)
770 struct prop_location
*rest
= property_change_wait_list
;
772 if (rest
->tick
== (int) tick
)
779 /* Nonzero if any properties for DISPLAY and WINDOW
780 are on the list of what we are waiting for. */
783 waiting_for_other_props_on_window (display
, window
)
787 struct prop_location
*rest
= property_change_wait_list
;
789 if (rest
->display
== display
&& rest
->window
== window
)
796 /* Add an entry to the list of property changes we are waiting for.
797 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
798 The return value is a number that uniquely identifies
799 this awaited property change. */
802 expect_property_change (display
, window
, property
, state
)
805 Lisp_Object property
;
808 struct prop_location
*pl
809 = (struct prop_location
*) xmalloc (sizeof (struct prop_location
));
810 pl
->tick
= ++prop_location_tick
;
811 pl
->display
= display
;
813 pl
->property
= property
;
814 pl
->desired_state
= state
;
815 pl
->next
= property_change_wait_list
;
816 property_change_wait_list
= pl
;
820 /* Delete an entry from the list of property changes we are waiting for.
821 TICK is the number that uniquely identifies the entry. */
824 unexpect_property_change (tick
)
827 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
830 if (rest
->tick
== tick
)
833 prev
->next
= rest
->next
;
835 property_change_wait_list
= rest
->next
;
844 /* Actually wait for a property change.
845 TICK should be the value that expect_property_change returned. */
848 wait_for_property_change (tick
)
850 XCONS (property_change_reply
)->car
= Qnil
;
851 property_change_reply_tick
= tick
;
852 wait_reading_process_input (0, 0, property_change_reply
, 0);
855 /* Called from XTread_socket in response to a PropertyNotify event. */
858 x_handle_property_notify (event
)
859 XPropertyEvent
*event
;
861 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
864 if (rest
->property
== event
->atom
865 && rest
->window
== event
->window
866 && rest
->display
== event
->display
867 && rest
->desired_state
== event
->state
)
870 fprintf (stderr
, "Saw expected prop-%s on %s\n",
871 (event
->state
== PropertyDelete
? "delete" : "change"),
872 (char *) XSYMBOL (x_atom_to_symbol (event
->display
,
877 /* If this is the one wait_for_property_change is waiting for,
878 tell it to wake up. */
879 if (rest
->tick
== property_change_reply_tick
)
880 XCONS (property_change_reply
)->car
= Qt
;
883 prev
->next
= rest
->next
;
885 property_change_wait_list
= rest
->next
;
893 fprintf (stderr
, "Saw UNexpected prop-%s on %s\n",
894 (event
->state
== PropertyDelete
? "delete" : "change"),
895 (char *) XSYMBOL (x_atom_to_symbol (event
->display
, event
->atom
))
902 #if 0 /* #### MULTIPLE doesn't work yet */
905 fetch_multiple_target (event
)
906 XSelectionRequestEvent
*event
;
908 Display
*display
= event
->display
;
909 Window window
= event
->requestor
;
910 Atom target
= event
->target
;
911 Atom selection_atom
= event
->selection
;
916 x_get_window_property_as_lisp_data (display
, window
, target
,
917 QMULTIPLE
, selection_atom
));
921 copy_multiple_data (obj
)
928 return Fcons (XCONS (obj
)->car
, copy_multiple_data (XCONS (obj
)->cdr
));
930 CHECK_VECTOR (obj
, 0);
931 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
932 for (i
= 0; i
< size
; i
++)
934 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
935 CHECK_VECTOR (vec2
, 0);
936 if (XVECTOR (vec2
)->size
!= 2)
937 /* ??? Confusing error message */
938 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
939 Fcons (vec2
, Qnil
)));
940 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
941 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
942 = XVECTOR (vec2
)->contents
[0];
943 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
944 = XVECTOR (vec2
)->contents
[1];
952 /* Variables for communication with x_handle_selection_notify. */
953 static Atom reading_which_selection
;
954 static Lisp_Object reading_selection_reply
;
955 static Window reading_selection_window
;
957 /* Do protocol to read selection-data from the server.
958 Converts this to Lisp data and returns it. */
961 x_get_foreign_selection (selection_symbol
, target_type
)
962 Lisp_Object selection_symbol
, target_type
;
964 Display
*display
= x_current_display
;
966 Window selecting_window
= XtWindow (selected_screen
->display
.x
->edit_widget
);
968 Window selecting_window
= FRAME_X_WINDOW (selected_frame
);
970 Time requestor_time
= mouse_timestamp
;
971 Atom target_property
= Xatom_EMACS_TMP
;
972 Atom selection_atom
= symbol_to_x_atom (display
, selection_symbol
);
975 if (CONSP (target_type
))
976 type_atom
= symbol_to_x_atom (display
, XCONS (target_type
)->car
);
978 type_atom
= symbol_to_x_atom (display
, target_type
);
981 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
982 requestor_window
, requestor_time
);
984 /* Prepare to block until the reply has been read. */
985 reading_selection_window
= requestor_window
;
986 reading_which_selection
= selection_atom
;
987 XCONS (reading_selection_reply
)->car
= Qnil
;
990 /* This allows quits. */
991 wait_reading_process_input (x_selection_timeout
, 0,
992 reading_selection_reply
, 0);
994 if (NILP (XCONS (reading_selection_reply
)->car
))
995 error ("timed out waiting for reply from selection owner");
997 /* Otherwise, the selection is waiting for us on the requested property. */
999 x_get_window_property_as_lisp_data (display
, requestor_window
,
1000 target_property
, target_type
,
1004 /* Subroutines of x_get_window_property_as_lisp_data */
1007 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1008 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1013 unsigned char **data_ret
;
1015 Atom
*actual_type_ret
;
1016 int *actual_format_ret
;
1017 unsigned long *actual_size_ret
;
1021 unsigned long bytes_remaining
;
1023 unsigned char *tmp_data
= 0;
1025 int buffer_size
= SELECTION_QUANTUM (display
);
1026 if (buffer_size
> MAX_SELECTION_QUANTUM
) buffer_size
= MAX_SELECTION_QUANTUM
;
1029 /* First probe the thing to find out how big it is. */
1030 result
= XGetWindowProperty (display
, window
, property
,
1031 0, 0, False
, AnyPropertyType
,
1032 actual_type_ret
, actual_format_ret
,
1034 &bytes_remaining
, &tmp_data
);
1036 if (result
!= Success
)
1043 XFree ((char *) tmp_data
);
1046 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1048 if (delete_p
) XDeleteProperty (display
, window
, property
);
1052 total_size
= bytes_remaining
+ 1;
1053 *data_ret
= (unsigned char *) xmalloc (total_size
);
1055 /* Now read, until weve gotten it all. */
1057 while (bytes_remaining
)
1060 int last
= bytes_remaining
;
1063 = XGetWindowProperty (display
, window
, property
,
1064 offset
/4, buffer_size
/4,
1065 (delete_p
? True
: False
),
1067 actual_type_ret
, actual_format_ret
,
1068 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1070 fprintf (stderr
, "<< read %d\n", last
-bytes_remaining
);
1072 /* If this doesn't return Success at this point, it means that
1073 some clod deleted the selection while we were in the midst of
1074 reading it. Deal with that, I guess....
1076 if (result
!= Success
) break;
1077 *actual_size_ret
*= *actual_format_ret
/ 8;
1078 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1079 offset
+= *actual_size_ret
;
1080 XFree ((char *) tmp_data
);
1083 *bytes_ret
= offset
;
1087 receive_incremental_selection (display
, window
, property
, target_type
,
1088 min_size_bytes
, data_ret
, size_bytes_ret
,
1089 type_ret
, format_ret
, size_ret
)
1093 Lisp_Object target_type
; /* for error messages only */
1094 unsigned int min_size_bytes
;
1095 unsigned char **data_ret
;
1096 int *size_bytes_ret
;
1098 unsigned long *size_ret
;
1103 *size_bytes_ret
= min_size_bytes
;
1104 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1106 fprintf (stderr
, "\nread INCR %d\n", min_size_bytes
);
1108 /* At this point, we have read an INCR property, and deleted it (which
1109 is how we ack its receipt: the sending window will be selecting
1110 PropertyNotify events on our window to notice this.)
1112 Now, we must loop, waiting for the sending window to put a value on
1113 that property, then reading the property, then deleting it to ack.
1114 We are done when the sender places a property of length 0.
1116 prop_id
= expect_property_change (display
, window
, property
,
1120 unsigned char *tmp_data
;
1122 wait_for_property_change (prop_id
);
1123 /* expect it again immediately, because x_get_window_property may
1124 .. no it wont, I dont get it.
1125 .. Ok, I get it now, the Xt code that implements INCR is broken.
1127 prop_id
= expect_property_change (display
, window
, property
,
1129 x_get_window_property (display
, window
, property
,
1130 &tmp_data
, &tmp_size_bytes
,
1131 type_ret
, format_ret
, size_ret
, 1);
1133 if (tmp_size_bytes
== 0) /* we're done */
1136 fprintf (stderr
, " read INCR done\n");
1138 unexpect_property_change (prop_id
);
1139 if (tmp_data
) xfree (tmp_data
);
1143 fprintf (stderr
, " read INCR %d\n", tmp_size_bytes
);
1145 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1148 fprintf (stderr
, " read INCR realloc %d -> %d\n",
1149 *size_bytes_ret
, offset
+ tmp_size_bytes
);
1151 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1152 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1154 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1155 offset
+= tmp_size_bytes
;
1160 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1161 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1162 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1165 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1170 Lisp_Object target_type
; /* for error messages only */
1171 Atom selection_atom
; /* for error messages only */
1175 unsigned long actual_size
;
1176 unsigned char *data
= 0;
1180 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1181 &actual_type
, &actual_format
, &actual_size
, 1);
1184 int there_is_a_selection_owner
;
1186 there_is_a_selection_owner
1187 = XGetSelectionOwner (display
, selection_atom
);
1189 while (1) /* Note debugger can no longer return, so this is obsolete */
1191 there_is_a_selection_owner
?
1192 Fcons (build_string ("selection owner couldn't convert"),
1194 ? Fcons (target_type
,
1195 Fcons (x_atom_to_symbol (display
, actual_type
),
1197 : Fcons (target_type
, Qnil
))
1198 : Fcons (build_string ("no selection"),
1199 Fcons (x_atom_to_symbol (display
, selection_atom
),
1203 if (actual_type
== Xatom_INCR
)
1205 /* That wasn't really the data, just the beginning. */
1207 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1209 XFree ((char *) data
);
1211 receive_incremental_selection (display
, window
, property
, target_type
,
1212 min_size_bytes
, &data
, &bytes
,
1213 &actual_type
, &actual_format
,
1217 /* It's been read. Now convert it to a lisp object in some semi-rational
1219 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1220 actual_type
, actual_format
);
1222 xfree ((char *) data
);
1226 /* These functions convert from the selection data read from the server into
1227 something that we can use from Lisp, and vice versa.
1229 Type: Format: Size: Lisp Type:
1230 ----- ------- ----- -----------
1233 ATOM 32 > 1 Vector of Symbols
1235 * 16 > 1 Vector of Integers
1236 * 32 1 if <=16 bits: Integer
1237 if > 16 bits: Cons of top16, bot16
1238 * 32 > 1 Vector of the above
1240 When converting a Lisp number to C, it is assumed to be of format 16 if
1241 it is an integer, and of format 32 if it is a cons of two integers.
1243 When converting a vector of numbers from Lisp to C, it is assumed to be
1244 of format 16 if every element in the vector is an integer, and is assumed
1245 to be of format 32 if any element is a cons of two integers.
1247 When converting an object to C, it may be of the form (SYMBOL . <data>)
1248 where SYMBOL is what we should claim that the type is. Format and
1249 representation are as above. */
1254 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1256 unsigned char *data
;
1261 if (type
== Xatom_NULL
)
1264 /* Convert any 8-bit data to a string, for compactness. */
1265 else if (format
== 8)
1266 return make_string ((char *) data
, size
);
1268 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1269 a vector of symbols.
1271 else if (type
== XA_ATOM
)
1274 if (size
== sizeof (Atom
))
1275 return x_atom_to_symbol (display
, *((Atom
*) data
));
1278 Lisp_Object v
= Fmake_vector (size
/ sizeof (Atom
), 0);
1279 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1280 Faset (v
, i
, x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1285 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1286 If the number is > 16 bits, convert it to a cons of integers,
1287 16 bits in each half.
1289 else if (format
== 32 && size
== sizeof (long))
1290 return long_to_cons (((unsigned long *) data
) [0]);
1291 else if (format
== 16 && size
== sizeof (short))
1292 return make_number ((int) (((unsigned short *) data
) [0]));
1294 /* Convert any other kind of data to a vector of numbers, represented
1295 as above (as an integer, or a cons of two 16 bit integers.)
1297 else if (format
== 16)
1300 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1301 for (i
= 0; i
< size
/ 4; i
++)
1303 int j
= (int) ((unsigned short *) data
) [i
];
1304 Faset (v
, i
, make_number (j
));
1311 Lisp_Object v
= Fmake_vector (size
/ 4, 0);
1312 for (i
= 0; i
< size
/ 4; i
++)
1314 unsigned long j
= ((unsigned long *) data
) [i
];
1315 Faset (v
, i
, long_to_cons (j
));
1323 lisp_data_to_selection_data (display
, obj
,
1324 data_ret
, type_ret
, size_ret
, format_ret
)
1327 unsigned char **data_ret
;
1329 unsigned int *size_ret
;
1332 Lisp_Object type
= Qnil
;
1333 if (CONSP (obj
) && SYMBOLP (XCONS (obj
)->car
))
1335 type
= XCONS (obj
)->car
;
1336 obj
= XCONS (obj
)->cdr
;
1337 if (CONSP (obj
) && NILP (XCONS (obj
)->cdr
))
1338 obj
= XCONS (obj
)->car
;
1341 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1342 { /* This is not the same as declining */
1348 else if (STRINGP (obj
))
1351 *size_ret
= XSTRING (obj
)->size
;
1352 *data_ret
= (unsigned char *) xmalloc (*size_ret
);
1353 memcpy (*data_ret
, (char *) XSTRING (obj
)->data
, *size_ret
);
1354 if (NILP (type
)) type
= QSTRING
;
1356 else if (SYMBOLP (obj
))
1360 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1361 (*data_ret
) [sizeof (Atom
)] = 0;
1362 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (display
, obj
);
1363 if (NILP (type
)) type
= QATOM
;
1365 else if (FIXNUMP (obj
)
1366 && XINT (obj
) < 0xFFFF
1367 && XINT (obj
) > -0xFFFF)
1371 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1372 (*data_ret
) [sizeof (short)] = 0;
1373 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1374 if (NILP (type
)) type
= QINTEGER
;
1376 else if (FIXNUMP (obj
) || CONSP (obj
))
1380 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1381 (*data_ret
) [sizeof (long)] = 0;
1382 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1383 if (NILP (type
)) type
= QINTEGER
;
1385 else if (VECTORP (obj
))
1387 /* Lisp_Vectors may represent a set of ATOMs;
1388 a set of 16 or 32 bit INTEGERs;
1389 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1393 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1394 /* This vector is an ATOM set */
1396 if (NILP (type
)) type
= QATOM
;
1397 *size_ret
= XVECTOR (obj
)->size
;
1399 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1400 for (i
= 0; i
< *size_ret
; i
++)
1401 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1402 (*(Atom
**) data_ret
) [i
]
1403 = symbol_to_x_atom (display
, XVECTOR (obj
)->contents
[i
]);
1405 Fsignal (Qerror
, /* Qselection_error */
1407 ("all elements of selection vector must have same type"),
1408 Fcons (obj
, Qnil
)));
1410 #if 0 /* #### MULTIPLE doesn't work yet */
1411 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1412 /* This vector is an ATOM_PAIR set */
1414 if (NILP (type
)) type
= QATOM_PAIR
;
1415 *size_ret
= XVECTOR (obj
)->size
;
1417 *data_ret
= (unsigned char *)
1418 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1419 for (i
= 0; i
< *size_ret
; i
++)
1420 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1422 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1423 if (XVECTOR (pair
)->size
!= 2)
1426 ("elements of the vector must be vectors of exactly two elements"),
1427 Fcons (pair
, Qnil
)));
1429 (*(Atom
**) data_ret
) [i
* 2]
1430 = symbol_to_x_atom (display
, XVECTOR (pair
)->contents
[0]);
1431 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1432 = symbol_to_x_atom (display
, XVECTOR (pair
)->contents
[1]);
1437 ("all elements of the vector must be of the same type"),
1438 Fcons (obj
, Qnil
)));
1443 /* This vector is an INTEGER set, or something like it */
1445 *size_ret
= XVECTOR (obj
)->size
;
1446 if (NILP (type
)) type
= QINTEGER
;
1448 for (i
= 0; i
< *size_ret
; i
++)
1449 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1451 else if (!FIXNUMP (XVECTOR (obj
)->contents
[i
]))
1452 Fsignal (Qerror
, /* Qselection_error */
1454 ("elements of selection vector must be integers or conses of integers"),
1455 Fcons (obj
, Qnil
)));
1457 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1458 for (i
= 0; i
< *size_ret
; i
++)
1459 if (*format_ret
== 32)
1460 (*((unsigned long **) data_ret
)) [i
]
1461 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1463 (*((unsigned short **) data_ret
)) [i
]
1464 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1468 Fsignal (Qerror
, /* Qselection_error */
1469 Fcons (build_string ("unrecognised selection data"),
1470 Fcons (obj
, Qnil
)));
1472 *type_ret
= symbol_to_x_atom (display
, type
);
1476 clean_local_selection_data (obj
)
1480 && FIXNUMP (XCONS (obj
)->car
)
1481 && CONSP (XCONS (obj
)->cdr
)
1482 && FIXNUMP (XCONS (XCONS (obj
)->cdr
)->car
)
1483 && NILP (XCONS (XCONS (obj
)->cdr
)->cdr
))
1484 obj
= Fcons (XCONS (obj
)->car
, XCONS (obj
)->cdr
);
1487 && FIXNUMP (XCONS (obj
)->car
)
1488 && FIXNUMP (XCONS (obj
)->cdr
))
1490 if (XINT (XCONS (obj
)->car
) == 0)
1491 return XCONS (obj
)->cdr
;
1492 if (XINT (XCONS (obj
)->car
) == -1)
1493 return make_number (- XINT (XCONS (obj
)->cdr
));
1498 int size
= XVECTOR (obj
)->size
;
1501 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1502 copy
= Fmake_vector (size
, Qnil
);
1503 for (i
= 0; i
< size
; i
++)
1504 XVECTOR (copy
)->contents
[i
]
1505 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1511 /* Called from XTread_socket to handle SelectionNotify events.
1512 If it's the selection we are waiting for, stop waiting. */
1515 x_handle_selection_notify (event
)
1516 XSelectionEvent
*event
;
1518 if (event
->requestor
!= reading_selection_window
)
1520 if (event
->selection
!= reading_which_selection
)
1523 XCONS (reading_selection_reply
)->car
= Qt
;
1527 DEFUN ("x-own-selection-internal",
1528 Fx_own_selection_internal
, Sx_own_selection_internal
,
1530 "Assert an X selection of the given TYPE with the given VALUE.\n\
1531 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1532 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1533 VALUE is typically a string, or a cons of two markers, but may be\n\
1534 anything that the functions on selection-converter-alist know about.")
1535 (selection_name
, selection_value
)
1536 Lisp_Object selection_name
, selection_value
;
1538 CHECK_SYMBOL (selection_name
, 0);
1539 if (NILP (selection_value
)) error ("selection-value may not be nil.");
1540 x_own_selection (selection_name
, selection_value
);
1541 return selection_value
;
1545 /* Request the selection value from the owner. If we are the owner,
1546 simply return our selection value. If we are not the owner, this
1547 will block until all of the data has arrived. */
1549 DEFUN ("x-get-selection-internal",
1550 Fx_get_selection_internal
, Sx_get_selection_internal
, 2, 2, 0,
1551 "Return text selected from some X window.\n\
1552 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1553 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1554 TYPE is the type of data desired, typically STRING.")
1555 (selection_symbol
, target_type
)
1556 Lisp_Object selection_symbol
, target_type
;
1558 Lisp_Object val
= Qnil
;
1559 struct gcpro gcpro1
, gcpro2
;
1560 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1561 CHECK_SYMBOL (selection_symbol
, 0);
1563 #if 0 /* #### MULTIPLE doesn't work yet */
1564 if (CONSP (target_type
)
1565 && XCONS (target_type
)->car
== QMULTIPLE
)
1567 CHECK_VECTOR (XCONS (target_type
)->cdr
, 0);
1568 /* So we don't destructively modify this... */
1569 target_type
= copy_multiple_data (target_type
);
1573 CHECK_SYMBOL (target_type
, 0);
1575 val
= x_get_local_selection (selection_symbol
, target_type
);
1579 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1584 && SYMBOLP (XCONS (val
)->car
))
1586 val
= XCONS (val
)->cdr
;
1587 if (CONSP (val
) && NILP (XCONS (val
)->cdr
))
1588 val
= XCONS (val
)->car
;
1590 val
= clean_local_selection_data (val
);
1596 DEFUN ("x-disown-selection-internal",
1597 Fx_disown_selection_internal
, Sx_disown_selection_internal
, 1, 2, 0,
1598 "If we own the named selection, then disown it (make there be no selection).")
1600 Lisp_Object selection
;
1603 Display
*display
= x_current_display
;
1605 Atom selection_atom
;
1606 XSelectionClearEvent event
;
1608 CHECK_SYMBOL (selection
, 0);
1610 timestamp
= mouse_timestamp
;
1612 timestamp
= cons_to_long (time
);
1614 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
1615 return Qnil
; /* Don't disown the selection when we're not the owner. */
1617 selection_atom
= symbol_to_x_atom (display
, selection
);
1620 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
1623 /* It doesn't seem to be guarenteed that a SelectionClear event will be
1624 generated for a window which owns the selection when that window sets
1625 the selection owner to None. The NCD server does, the MIT Sun4 server
1626 doesn't. So we synthesize one; this means we might get two, but
1627 that's ok, because the second one won't have any effect. */
1628 event
.display
= display
;
1629 event
.selection
= selection_atom
;
1630 event
.time
= timestamp
;
1631 x_handle_selection_clear (&event
);
1637 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
1639 "Whether the current emacs process owns the given X Selection.\n\
1640 The arg should be the name of the selection in question, typically one of\n\
1641 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1642 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1643 For convenience, the symbol nil is the same as `PRIMARY',\n\
1644 and t is the same as `SECONDARY'.)")
1646 Lisp_Object selection
;
1648 CHECK_SYMBOL (selection
, 0);
1649 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
1650 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
1652 if (NILP (Fassq (selection
, Vselection_alist
)))
1657 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
1659 "Whether there is an owner for the given X Selection.\n\
1660 The arg should be the name of the selection in question, typically one of\n\
1661 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1662 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1663 For convenience, the symbol nil is the same as `PRIMARY',\n\
1664 and t is the same as `SECONDARY'.)")
1666 Lisp_Object selection
;
1669 Display
*dpy
= x_current_display
;
1670 CHECK_SYMBOL (selection
, 0);
1671 if (!NILP (Fx_selection_owner_p (selection
)))
1674 owner
= XGetSelectionOwner (dpy
, symbol_to_x_atom (dpy
, selection
));
1676 return (owner
? Qt
: Qnil
);
1680 #ifdef CUT_BUFFER_SUPPORT
1682 static int cut_buffers_initialized
; /* Whether we're sure they all exist */
1684 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1686 initialize_cut_buffers (display
, window
)
1690 unsigned char *data
= (unsigned char *) "";
1692 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1693 PropModeAppend, data, 0)
1694 FROB (XA_CUT_BUFFER0
);
1695 FROB (XA_CUT_BUFFER1
);
1696 FROB (XA_CUT_BUFFER2
);
1697 FROB (XA_CUT_BUFFER3
);
1698 FROB (XA_CUT_BUFFER4
);
1699 FROB (XA_CUT_BUFFER5
);
1700 FROB (XA_CUT_BUFFER6
);
1701 FROB (XA_CUT_BUFFER7
);
1704 cut_buffers_initialized
= 1;
1708 #define CHECK_CUTBUFFER(symbol,n) \
1709 { CHECK_SYMBOL ((symbol), (n)); \
1710 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1711 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1712 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1713 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1715 Fcons (build_string ("doesn't name a cutbuffer"), \
1716 Fcons ((symbol), Qnil))); \
1719 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal
,
1720 Sx_get_cutbuffer_internal
, 1, 1, 0,
1721 "Returns the value of the named cutbuffer (typically CUT_BUFFER0).")
1725 Display
*display
= x_current_display
;
1726 Window window
= RootWindow (display
, 0); /* Cutbuffers are on screen 0 */
1728 unsigned char *data
;
1735 CHECK_CUTBUFFER (buffer
, 0);
1736 buffer_atom
= symbol_to_x_atom (display
, buffer
);
1738 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
1739 &type
, &format
, &size
, 0);
1740 if (!data
) return Qnil
;
1742 if (format
!= 8 || type
!= XA_STRING
)
1744 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1745 Fcons (x_atom_to_symbol (display
, type
),
1746 Fcons (make_number (format
), Qnil
))));
1748 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
1754 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal
,
1755 Sx_store_cutbuffer_internal
, 2, 2, 0,
1756 "Sets the value of the named cutbuffer (typically CUT_BUFFER0).")
1758 Lisp_Object buffer
, string
;
1760 Display
*display
= x_current_display
;
1761 Window window
= RootWindow (display
, 0); /* Cutbuffers are on screen 0 */
1763 unsigned char *data
;
1765 int bytes_remaining
;
1766 int max_bytes
= SELECTION_QUANTUM (display
);
1767 if (max_bytes
> MAX_SELECTION_QUANTUM
) max_bytes
= MAX_SELECTION_QUANTUM
;
1769 CHECK_CUTBUFFER (buffer
, 0);
1770 CHECK_STRING (string
, 0);
1771 buffer_atom
= symbol_to_x_atom (display
, buffer
);
1772 data
= (unsigned char *) XSTRING (string
)->data
;
1773 bytes
= XSTRING (string
)->size
;
1774 bytes_remaining
= bytes
;
1776 if (! cut_buffers_initialized
) initialize_cut_buffers (display
, window
);
1779 while (bytes_remaining
)
1781 int chunk
= (bytes_remaining
< max_bytes
1782 ? bytes_remaining
: max_bytes
);
1783 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
1784 (bytes_remaining
== bytes
1789 bytes_remaining
-= chunk
;
1796 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal
,
1797 Sx_rotate_cutbuffers_internal
, 1, 1, 0,
1798 "Rotate the values of the cutbuffers by the given number of steps;\n\
1799 positive means move values forward, negative means backward.")
1803 Display
*display
= x_current_display
;
1804 Window window
= RootWindow (display
, 0); /* Cutbuffers are on screen 0 */
1807 CHECK_FIXNUM (n
, 0);
1808 if (XINT (n
) == 0) return n
;
1809 if (! cut_buffers_initialized
) initialize_cut_buffers (display
, window
);
1810 props
[0] = XA_CUT_BUFFER0
;
1811 props
[1] = XA_CUT_BUFFER1
;
1812 props
[2] = XA_CUT_BUFFER2
;
1813 props
[3] = XA_CUT_BUFFER3
;
1814 props
[4] = XA_CUT_BUFFER4
;
1815 props
[5] = XA_CUT_BUFFER5
;
1816 props
[6] = XA_CUT_BUFFER6
;
1817 props
[7] = XA_CUT_BUFFER7
;
1819 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
1829 #define ATOM(x) XInternAtom (x_current_display, (x), False)
1832 /* Non-predefined atoms that we might end up using a lot */
1833 Xatom_CLIPBOARD
= ATOM ("CLIPBOARD");
1834 Xatom_TIMESTAMP
= ATOM ("TIMESTAMP");
1835 Xatom_TEXT
= ATOM ("TEXT");
1836 Xatom_DELETE
= ATOM ("DELETE");
1837 Xatom_MULTIPLE
= ATOM ("MULTIPLE");
1838 Xatom_INCR
= ATOM ("INCR");
1839 Xatom_EMACS_TMP
= ATOM ("_EMACS_TMP_");
1840 Xatom_TARGETS
= ATOM ("TARGETS");
1841 Xatom_NULL
= ATOM ("NULL");
1842 Xatom_ATOM_PAIR
= ATOM ("ATOM_PAIR");
1851 defsubr (&Sx_get_selection_internal
);
1852 defsubr (&Sx_own_selection_internal
);
1853 defsubr (&Sx_disown_selection_internal
);
1854 defsubr (&Sx_selection_owner_p
);
1855 defsubr (&Sx_selection_exists_p
);
1857 #ifdef CUT_BUFFER_SUPPORT
1858 defsubr (&Sx_get_cutbuffer_internal
);
1859 defsubr (&Sx_store_cutbuffer_internal
);
1860 defsubr (&Sx_rotate_cutbuffers_internal
);
1861 cut_buffers_initialized
= 0;
1864 reading_selection_reply
= Fcons (Qnil
, Qnil
);
1865 staticpro (&reading_selection_reply
);
1866 reading_selection_window
= 0;
1867 reading_which_selection
= 0;
1869 property_change_wait_list
= 0;
1870 prop_location_tick
= 0;
1871 property_change_reply
= Fcons (Qnil
, Qnil
);
1872 staticpro (&property_change_reply
);
1874 Vselection_alist
= Qnil
;
1875 staticpro (&Vselection_alist
);
1877 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
1878 "An alist associating X Windows selection-types with functions.\n\
1879 These functions are called to convert the selection, with three args:\n\
1880 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
1881 a desired type to which the selection should be converted;\n\
1882 and the local selection value (whatever was given to `x-own-selection').\n\
1884 The function should return the value to send to the X server\n\
1885 \(typically a string). A return value of nil\n\
1886 means that the conversion could not be done.\n\
1887 A return value which is the symbol `NULL'\n\
1888 means that a side-effect was executed,\n\
1889 and there is no meaningful selection value.");
1890 Vselection_converter_alist
= Qnil
;
1892 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
1893 "A list of functions to be called when Emacs loses an X selection.\n\
1894 \(This happens when some other X client makes its own selection\n\
1895 or when a Lisp program explicitly clears the selection.)\n\
1896 The functions are called with one argument, the selection type\n\
1897 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
1898 Vx_lost_selection_hooks
= Qnil
;
1900 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
1901 "A list of functions to be called when Emacs answers a selection request.\n\
1902 The functions are called with four arguments:\n\
1903 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
1904 - the selection-type which Emacs was asked to convert the\n\
1905 selection into before sending (for example, `STRING' or `LENGTH');\n\
1906 - a flag indicating success or failure for responding to the request.\n\
1907 We might have failed (and declined the request) for any number of reasons,\n\
1908 including being asked for a selection that we no longer own, or being asked\n\
1909 to convert into a type that we don't know about or that is inappropriate.\n\
1910 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
1911 it merely informs you that they have happened.");
1912 Vx_sent_selection_hooks
= Qnil
;
1914 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
1915 "Number of seconds to wait for a selection reply from another X client.\n\
1916 If the selection owner doens't reply in this many seconds, we give up.\n\
1917 A value of 0 means wait as long as necessary. This is initialized from the\n\
1918 \"*selectionTimeout\" resource (which is expressed in milliseconds).");
1919 x_selection_timeout
= 0;
1921 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
1922 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
1923 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
1924 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
1925 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
1926 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
1927 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
1928 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
1929 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
1930 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
1931 QINCR
= intern ("INCR"); staticpro (&QINCR
);
1932 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
1933 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
1934 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
1935 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
1936 QNULL
= intern ("NULL"); staticpro (&QNULL
);
1938 #ifdef CUT_BUFFER_SUPPORT
1939 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
1940 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
1941 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
1942 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
1943 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
1944 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
1945 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
1946 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);