Commit | Line | Data |
---|---|---|
f3a0bf5c | 1 | /* X Selection processing for emacs |
dbc4e1c1 | 2 | Copyright (C) 1990, 1992, 1993 Free Software Foundation. |
f3a0bf5c JB |
3 | |
4 | This file is part of GNU Emacs. | |
5 | ||
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 | |
ffd56f97 | 8 | the Free Software Foundation; either version 2, or (at your option) |
f3a0bf5c JB |
9 | any later version. |
10 | ||
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. | |
15 | ||
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. */ | |
19 | ||
20 | #include "config.h" | |
21 | #include "lisp.h" | |
22 | #include "xterm.h" | |
3c254570 | 23 | #include "buffer.h" |
f676886a | 24 | #include "frame.h" |
f3a0bf5c JB |
25 | |
26 | #ifdef HAVE_X11 | |
27 | ||
28 | /* Macros for X Selections */ | |
3c254570 JA |
29 | #define MAX_SELECTION(dpy) (((dpy)->max_request_size << 2) - 100) |
30 | #define SELECTION_LENGTH(len,format) ((len) * ((format) >> 2)) | |
f3a0bf5c | 31 | |
1113d9db JB |
32 | /* The timestamp of the last input event we received from the X server. */ |
33 | unsigned long last_event_timestamp; | |
ffd56f97 | 34 | |
f3a0bf5c | 35 | /* t if a mouse button is depressed. */ |
f3a0bf5c JB |
36 | extern Lisp_Object Vmouse_grabbed; |
37 | ||
38 | /* When emacs became the PRIMARY selection owner. */ | |
39 | Time x_begin_selection_own; | |
40 | ||
3c254570 JA |
41 | /* When emacs became the SECONDARY selection owner. */ |
42 | Time x_begin_secondary_selection_own; | |
43 | ||
f3a0bf5c JB |
44 | /* When emacs became the CLIPBOARD selection owner. */ |
45 | Time x_begin_clipboard_own; | |
46 | ||
47 | /* The value of the current CLIPBOARD selection. */ | |
48 | Lisp_Object Vx_clipboard_value; | |
49 | ||
50 | /* The value of the current PRIMARY selection. */ | |
51 | Lisp_Object Vx_selection_value; | |
52 | ||
3c254570 JA |
53 | /* The value of the current SECONDARY selection. */ |
54 | Lisp_Object Vx_secondary_selection_value; | |
55 | ||
234a804b JB |
56 | /* Types of selections we may make. */ |
57 | Lisp_Object Qprimary, Qsecondary, Qclipboard; | |
3c254570 JA |
58 | |
59 | /* Emacs' selection property identifiers. */ | |
f3a0bf5c | 60 | Atom Xatom_emacs_selection; |
3c254570 | 61 | Atom Xatom_emacs_secondary_selection; |
f3a0bf5c JB |
62 | |
63 | /* Clipboard selection atom. */ | |
64 | Atom Xatom_clipboard_selection; | |
65 | ||
66 | /* Clipboard atom. */ | |
67 | Atom Xatom_clipboard; | |
68 | ||
69 | /* Atom for indicating incremental selection transfer. */ | |
70 | Atom Xatom_incremental; | |
71 | ||
72 | /* Atom for indicating multiple selection request list */ | |
73 | Atom Xatom_multiple; | |
74 | ||
75 | /* Atom for what targets emacs handles. */ | |
76 | Atom Xatom_targets; | |
77 | ||
78 | /* Atom for indicating timstamp selection request */ | |
79 | Atom Xatom_timestamp; | |
80 | ||
81 | /* Atom requesting we delete our selection. */ | |
82 | Atom Xatom_delete; | |
83 | ||
84 | /* Selection magic. */ | |
85 | Atom Xatom_insert_selection; | |
86 | ||
87 | /* Type of property for INSERT_SELECTION. */ | |
88 | Atom Xatom_pair; | |
89 | ||
90 | /* More selection magic. */ | |
91 | Atom Xatom_insert_property; | |
92 | ||
93 | /* Atom for indicating property type TEXT */ | |
94 | Atom Xatom_text; | |
95 | ||
3c254570 JA |
96 | /* Kinds of protocol things we may receive. */ |
97 | Atom Xatom_wm_take_focus; | |
98 | Atom Xatom_wm_save_yourself; | |
99 | Atom Xatom_wm_delete_window; | |
100 | ||
101 | /* Communication with window managers. */ | |
102 | Atom Xatom_wm_protocols; | |
103 | ||
f3a0bf5c JB |
104 | /* These are to handle incremental selection transfer. */ |
105 | Window incr_requestor; | |
106 | Atom incr_property; | |
107 | int incr_nbytes; | |
108 | unsigned char *incr_value; | |
109 | unsigned char *incr_ptr; | |
110 | ||
234a804b JB |
111 | /* Declarations for handling cut buffers. |
112 | ||
113 | Whenever we set a cut buffer or read a cut buffer's value, we cache | |
114 | it in cut_buffer_value. We look for PropertyNotify events about | |
115 | the CUT_BUFFER properties, and invalidate our cache accordingly. | |
116 | We ignore PropertyNotify events that we suspect were caused by our | |
117 | own changes to the cut buffers, so we can keep the cache valid | |
118 | longer. | |
119 | ||
120 | IS ALL THIS HAIR WORTH IT? Well, these functions get called every | |
121 | time an element goes into or is retrieved from the kill ring, and | |
122 | those ought to be quick. It's not fun in time or space to wait for | |
123 | 50k cut buffers to fly back and forth across the net. */ | |
124 | ||
125 | /* The number of CUT_BUFFER properties defined under X. */ | |
126 | #define NUM_CUT_BUFFERS (8) | |
127 | ||
128 | /* cut_buffer_atom[n] is the atom naming the nth cut buffer. */ | |
129 | static Atom cut_buffer_atom[NUM_CUT_BUFFERS] = { | |
130 | XA_CUT_BUFFER0, XA_CUT_BUFFER1, XA_CUT_BUFFER2, XA_CUT_BUFFER3, | |
131 | XA_CUT_BUFFER4, XA_CUT_BUFFER5, XA_CUT_BUFFER6, XA_CUT_BUFFER7 | |
132 | }; | |
133 | ||
134 | /* cut_buffer_value is an eight-element vector; | |
135 | (aref cut_buffer_value n) is the cached value of cut buffer n, or | |
136 | Qnil if cut buffer n is unset. */ | |
137 | static Lisp_Object cut_buffer_value; | |
138 | ||
139 | /* Bit N of cut_buffer_cached is true if (aref cut_buffer_value n) is | |
140 | known to be valid. This is cleared by PropertyNotify events | |
141 | handled by x_invalidate_cut_buffer_cache. It would be wonderful if | |
142 | that routine could just set the appropriate element of | |
143 | cut_buffer_value to some special value meaning "uncached", but that | |
144 | would lose if a GC happened to be in progress. | |
145 | ||
146 | Bit N of cut_buffer_just_set is true if cut buffer N has been set since | |
147 | the last PropertyNotify event; since we get an event even when we set | |
148 | the property ourselves, we should ignore one event after setting | |
149 | a cut buffer, so we don't have to throw away our cache. */ | |
150 | #ifdef __STDC__ | |
151 | volatile | |
152 | #endif | |
153 | static cut_buffer_cached, cut_buffer_just_set; | |
154 | ||
155 | \f | |
156 | /* Acquiring ownership of a selection. */ | |
f3a0bf5c | 157 | |
f3a0bf5c | 158 | |
3c254570 JA |
159 | /* Request selection ownership if we do not already have it. */ |
160 | ||
161 | static int | |
162 | own_selection (selection_type, time) | |
163 | Atom selection_type; | |
164 | Time time; | |
f3a0bf5c JB |
165 | { |
166 | Window owner_window, selecting_window; | |
f3a0bf5c | 167 | |
de02ad0b JB |
168 | if ((selection_type == XA_PRIMARY |
169 | && !NILP (Vx_selection_value)) | |
170 | || (selection_type == XA_SECONDARY | |
171 | && !NILP (Vx_secondary_selection_value)) | |
172 | || (selection_type == Xatom_clipboard | |
173 | && !NILP (Vx_clipboard_value))) | |
3c254570 | 174 | return 1; |
f3a0bf5c | 175 | |
fcb9ffc8 | 176 | selecting_window = FRAME_X_WINDOW (selected_frame); |
3c254570 JA |
177 | XSetSelectionOwner (x_current_display, selection_type, |
178 | selecting_window, time); | |
179 | owner_window = XGetSelectionOwner (x_current_display, selection_type); | |
f3a0bf5c | 180 | |
ffd56f97 | 181 | if (owner_window != selecting_window) |
3c254570 | 182 | return 0; |
f3a0bf5c | 183 | |
3c254570 | 184 | return 1; |
f3a0bf5c JB |
185 | } |
186 | ||
3c254570 JA |
187 | /* Become the selection owner and make our data the selection value. |
188 | If we are already the owner, merely change data and timestamp values. | |
189 | This avoids generating SelectionClear events for ourselves. */ | |
f3a0bf5c | 190 | |
dbc4e1c1 JB |
191 | DEFUN ("x-set-selection", Fx_set_selection, Sx_set_selection, |
192 | 2, 2, "", | |
193 | "Set the value of SELECTION to STRING.\n\ | |
194 | SELECTION may be `primary', `secondary', or `clipboard'.\n\ | |
1113d9db | 195 | \n\ |
dbc4e1c1 JB |
196 | Selections are a mechanism for cutting and pasting information between\n\ |
197 | X Windows clients. Emacs's kill ring commands set the `primary'\n\ | |
198 | selection to the top string of the kill ring, making it available to\n\ | |
199 | other clients, like xterm. Those commands also use the `primary'\n\ | |
200 | selection to retrieve information from other clients.\n\ | |
201 | \n\ | |
202 | According to the Inter-Client Communications Conventions Manual:\n\ | |
203 | \n\ | |
204 | The `primary' selection \"... is used for all commands that take only a\n\ | |
205 | single argument and is the principal means of communication between\n\ | |
206 | clients that use the selection mechanism.\" In Emacs, this means\n\ | |
207 | that the kill ring commands set the primary selection to the text\n\ | |
208 | put in the kill ring.\n\ | |
209 | \n\ | |
210 | The `secondary' selection \"... is used as the second argument to\n\ | |
211 | commands taking two arguments (for example, `exchange primary and\n\ | |
212 | secondary selections'), and as a means of obtaining data when there\n\ | |
213 | is a primary selection and the user does not want to disturb it.\"\n\ | |
214 | I am not sure how Emacs should use the secondary selection; if you\n\ | |
215 | come up with ideas, this function will at least let you get at it.\n\ | |
216 | \n\ | |
217 | The `clipboard' selection \"... is used to hold data that is being\n\ | |
218 | transferred between clients, that is, data that usually is being\n\ | |
219 | cut or copied, and then pasted.\" It seems that the `clipboard'\n\ | |
220 | selection is for the most part equivalent to the `primary'\n\ | |
221 | selection, so Emacs sets them both.\n\ | |
222 | \n\ | |
223 | Also see `x-selection', and the `interprogram-cut-function' variable.") | |
224 | (selection, string) | |
225 | register Lisp_Object selection, string; | |
f3a0bf5c | 226 | { |
3c254570 JA |
227 | Atom selection_type; |
228 | Lisp_Object val; | |
1113d9db | 229 | Time event_time = last_event_timestamp; |
f3a0bf5c JB |
230 | CHECK_STRING (string, 0); |
231 | ||
638cb9c6 JB |
232 | val = Qnil; |
233 | ||
dbc4e1c1 | 234 | if (NILP (selection) || EQ (selection, Qprimary)) |
f3a0bf5c | 235 | { |
3c254570 JA |
236 | BLOCK_INPUT; |
237 | if (own_selection (XA_PRIMARY, event_time)) | |
f3a0bf5c | 238 | { |
3c254570 JA |
239 | x_begin_selection_own = event_time; |
240 | val = Vx_selection_value = string; | |
f3a0bf5c | 241 | } |
1113d9db | 242 | UNBLOCK_INPUT; |
f3a0bf5c | 243 | } |
dbc4e1c1 | 244 | else if (EQ (selection, Qsecondary)) |
3c254570 JA |
245 | { |
246 | BLOCK_INPUT; | |
247 | if (own_selection (XA_SECONDARY, event_time)) | |
248 | { | |
249 | x_begin_secondary_selection_own = event_time; | |
250 | val = Vx_secondary_selection_value = string; | |
251 | } | |
252 | UNBLOCK_INPUT; | |
253 | } | |
dbc4e1c1 | 254 | else if (EQ (selection, Qclipboard)) |
3c254570 JA |
255 | { |
256 | BLOCK_INPUT; | |
257 | if (own_selection (Xatom_clipboard, event_time)) | |
258 | { | |
1113d9db | 259 | x_begin_clipboard_own = event_time; |
3c254570 JA |
260 | val = Vx_clipboard_value = string; |
261 | } | |
1113d9db JB |
262 | UNBLOCK_INPUT; |
263 | } | |
3c254570 JA |
264 | else |
265 | error ("Invalid X selection type"); | |
f3a0bf5c | 266 | |
3c254570 | 267 | return val; |
f3a0bf5c JB |
268 | } |
269 | ||
270 | /* Clear our selection ownership data, as some other client has | |
271 | become the owner. */ | |
272 | ||
273 | void | |
274 | x_disown_selection (old_owner, selection, changed_owner_time) | |
275 | Window *old_owner; | |
276 | Atom selection; | |
277 | Time changed_owner_time; | |
278 | { | |
f676886a | 279 | struct frame *s = x_window_to_frame (old_owner); |
f3a0bf5c JB |
280 | |
281 | if (s) /* We are the owner */ | |
282 | { | |
283 | if (selection == XA_PRIMARY) | |
284 | { | |
285 | x_begin_selection_own = 0; | |
286 | Vx_selection_value = Qnil; | |
287 | } | |
3c254570 JA |
288 | else if (selection == XA_SECONDARY) |
289 | { | |
290 | x_begin_secondary_selection_own = 0; | |
291 | Vx_secondary_selection_value = Qnil; | |
292 | } | |
f3a0bf5c JB |
293 | else if (selection == Xatom_clipboard) |
294 | { | |
295 | x_begin_clipboard_own = 0; | |
296 | Vx_clipboard_value = Qnil; | |
297 | } | |
298 | else | |
299 | abort (); | |
300 | } | |
301 | else | |
302 | abort (); /* Inconsistent state. */ | |
303 | } | |
304 | ||
234a804b JB |
305 | \f |
306 | /* Answering selection requests. */ | |
307 | ||
f3a0bf5c JB |
308 | int x_selection_alloc_error; |
309 | int x_converting_selection; | |
310 | ||
234a804b JB |
311 | /* Reply to some client's request for our selection data. |
312 | Data is placed in a property supplied by the requesting window. | |
f3a0bf5c JB |
313 | |
314 | If the data exceeds the maximum amount the server can send, | |
315 | then prepare to send it incrementally, and reply to the client with | |
316 | the total size of the data. | |
317 | ||
318 | But first, check for all the other crufty stuff we could get. */ | |
319 | ||
320 | void | |
321 | x_answer_selection_request (event) | |
322 | XSelectionRequestEvent event; | |
323 | { | |
324 | Time emacs_own_time; | |
325 | Lisp_Object selection_value; | |
326 | XSelectionEvent evt; | |
327 | int format = 8; /* We have only byte sized (text) data. */ | |
328 | ||
329 | evt.type = SelectionNotify; /* Construct reply event */ | |
330 | evt.display = event.display; | |
331 | evt.requestor = event.requestor; | |
332 | evt.selection = event.selection; | |
333 | evt.time = event.time; | |
334 | evt.target = event.target; | |
335 | ||
336 | if (event.selection == XA_PRIMARY) | |
337 | { | |
338 | emacs_own_time = x_begin_selection_own; | |
339 | selection_value = Vx_selection_value; | |
340 | } | |
3c254570 JA |
341 | else if (event.selection == XA_SECONDARY) |
342 | { | |
343 | emacs_own_time = x_begin_secondary_selection_own; | |
344 | selection_value = Vx_secondary_selection_value; | |
345 | } | |
f3a0bf5c JB |
346 | else if (event.selection == Xatom_clipboard) |
347 | { | |
348 | emacs_own_time = x_begin_clipboard_own; | |
349 | selection_value = Vx_clipboard_value; | |
350 | } | |
351 | else | |
352 | abort (); | |
353 | ||
354 | if (event.time != CurrentTime | |
355 | && event.time < emacs_own_time) | |
356 | evt.property = None; | |
357 | else | |
358 | { | |
359 | if (event.property == None) /* obsolete client */ | |
360 | evt.property = event.target; | |
361 | else | |
362 | evt.property = event.property; | |
363 | } | |
364 | ||
365 | if (event.target == Xatom_targets) /* Send List of target atoms */ | |
366 | { | |
367 | } | |
368 | else if (event.target == Xatom_multiple) /* Recvd list: <target, prop> */ | |
369 | { | |
370 | Atom type; | |
371 | int return_format; | |
372 | unsigned long items, bytes_left; | |
373 | unsigned char *data; | |
374 | int result, i; | |
375 | ||
3c254570 | 376 | if (event.property == 0 /* 0 == NILP */ |
f3a0bf5c JB |
377 | || event.property == None) |
378 | return; | |
379 | ||
380 | result = XGetWindowProperty (event.display, event.requestor, | |
381 | event.property, 0L, 10000000L, | |
382 | True, Xatom_pair, &type, &return_format, | |
383 | &items, &bytes_left, &data); | |
384 | ||
385 | if (result == Success && type == Xatom_pair) | |
386 | for (i = items; i > 0; i--) | |
387 | { | |
388 | /* Convert each element of the list. */ | |
389 | } | |
390 | ||
391 | (void) XSendEvent (x_current_display, evt.requestor, False, | |
392 | 0L, (XEvent *) &evt); | |
393 | return; | |
394 | } | |
395 | else if (event.target == Xatom_timestamp) /* Send ownership timestamp */ | |
396 | { | |
397 | if (! emacs_own_time) | |
398 | abort (); | |
399 | ||
400 | format = 32; | |
401 | XChangeProperty (evt.display, evt.requestor, evt.property, | |
402 | evt.target, format, PropModeReplace, | |
3c254570 | 403 | (unsigned char *) &emacs_own_time, 1); |
f3a0bf5c JB |
404 | return; |
405 | } | |
406 | else if (event.target == Xatom_delete) /* Delete our selection. */ | |
407 | { | |
408 | if (EQ (Qnil, selection_value)) | |
409 | abort (); | |
410 | ||
411 | x_disown_selection (event.owner, event.selection, event.time); | |
412 | ||
3c254570 | 413 | /* Now return property of type NILP, length 0. */ |
f3a0bf5c JB |
414 | XChangeProperty (event.display, event.requestor, event.property, |
415 | 0, format, PropModeReplace, (unsigned char *) 0, 0); | |
416 | return; | |
417 | } | |
418 | else if (event.target == Xatom_insert_selection) | |
419 | { | |
420 | Atom type; | |
421 | int return_format; | |
422 | unsigned long items, bytes_left; | |
423 | unsigned char *data; | |
424 | int result = XGetWindowProperty (event.display, event.requestor, | |
425 | event.property, 0L, 10000000L, | |
426 | True, Xatom_pair, &type, &return_format, | |
427 | &items, &bytes_left, &data); | |
428 | if (result == Success && type == Xatom_pair) | |
429 | { | |
430 | /* Convert the first atom to (a selection) to the target | |
431 | indicated by the second atom. */ | |
432 | } | |
433 | } | |
434 | else if (event.target == Xatom_insert_property) | |
435 | { | |
436 | Atom type; | |
437 | int return_format; | |
438 | unsigned long items, bytes_left; | |
439 | unsigned char *data; | |
440 | int result = XGetWindowProperty (event.display, event.requestor, | |
441 | event.property, 0L, 10000000L, | |
442 | True, XA_STRING, &type, &return_format, | |
443 | &items, &bytes_left, &data); | |
444 | ||
445 | if (result == Success && type == XA_STRING && return_format == 8) | |
446 | { | |
447 | if (event.selection == Xatom_emacs_selection) | |
448 | Vx_selection_value = make_string (data); | |
3c254570 JA |
449 | else if (event.selection == Xatom_emacs_secondary_selection) |
450 | Vx_secondary_selection_value = make_string (data); | |
f3a0bf5c JB |
451 | else if (event.selection == Xatom_clipboard_selection) |
452 | Vx_clipboard_value = make_string (data); | |
453 | else | |
454 | abort (); | |
455 | } | |
456 | ||
457 | return; | |
458 | } | |
459 | else if ((event.target == Xatom_text | |
460 | || event.target == XA_STRING)) | |
461 | { | |
462 | int size = XSTRING (selection_value)->size; | |
463 | unsigned char *data = XSTRING (selection_value)->data; | |
464 | ||
465 | if (EQ (Qnil, selection_value)) | |
466 | abort (); | |
467 | ||
468 | /* Place data on requestor window's property. */ | |
469 | if (SELECTION_LENGTH (size, format) | |
470 | <= MAX_SELECTION (x_current_display)) | |
471 | { | |
472 | x_converting_selection = 1; | |
473 | XChangeProperty (evt.display, evt.requestor, evt.property, | |
474 | evt.target, format, PropModeReplace, | |
475 | data, size); | |
476 | if (x_selection_alloc_error) | |
477 | { | |
478 | x_selection_alloc_error = 0; | |
479 | abort (); | |
480 | } | |
481 | x_converting_selection = 0; | |
482 | } | |
483 | else /* Send incrementally */ | |
484 | { | |
485 | evt.target = Xatom_incremental; | |
486 | incr_requestor = evt.requestor; | |
487 | incr_property = evt.property; | |
488 | x_converting_selection = 1; | |
489 | ||
490 | /* Need to handle Alloc errors on these requests. */ | |
491 | XChangeProperty (evt.display, incr_requestor, incr_property, | |
492 | Xatom_incremental, 32, | |
493 | PropModeReplace, | |
494 | (unsigned char *) &size, 1); | |
495 | if (x_selection_alloc_error) | |
496 | { | |
497 | x_selection_alloc_error = 0; | |
498 | x_converting_selection = 0; | |
499 | abort (); | |
500 | /* Now abort the send. */ | |
501 | } | |
502 | ||
503 | incr_nbytes = size; | |
504 | incr_value = data; | |
505 | incr_ptr = data; | |
506 | ||
507 | /* Ask for notification when requestor deletes property. */ | |
508 | XSelectInput (x_current_display, incr_requestor, PropertyChangeMask); | |
509 | ||
510 | /* If we're sending incrementally, perhaps block here | |
511 | until all sent? */ | |
512 | } | |
513 | } | |
514 | else | |
515 | evt.property = None; | |
516 | ||
517 | /* Don't do this if there was an Alloc error: abort the transfer | |
518 | by sending None. */ | |
519 | (void) XSendEvent (x_current_display, evt.requestor, False, | |
520 | 0L, (XEvent *) &evt); | |
521 | } | |
522 | ||
523 | /* Send an increment of selection data in response to a PropertyNotify event. | |
524 | The increment is placed in a property on the requestor's window. | |
525 | When the requestor has processed the increment, it deletes the property, | |
526 | which sends us another PropertyNotify event. | |
527 | ||
528 | When there is no more data to send, we send a zero-length increment. */ | |
529 | ||
530 | void | |
531 | x_send_incremental (event) | |
532 | XPropertyEvent event; | |
533 | { | |
534 | if (incr_requestor | |
535 | && incr_requestor == event.window | |
536 | && incr_property == event.atom | |
537 | && event.state == PropertyDelete) | |
538 | { | |
539 | int format = 8; | |
540 | int length = MAX_SELECTION (x_current_display); | |
541 | int bytes_left = (incr_nbytes - (incr_ptr - incr_value)); | |
542 | ||
543 | if (length > bytes_left) /* Also sends 0 len when finished. */ | |
544 | length = bytes_left; | |
545 | XChangeProperty (x_current_display, incr_requestor, | |
546 | incr_property, XA_STRING, format, | |
547 | PropModeAppend, incr_ptr, length); | |
548 | if (x_selection_alloc_error) | |
549 | { | |
550 | x_selection_alloc_error = 0; | |
551 | x_converting_selection = 0; | |
552 | /* Abandon the transmission. */ | |
553 | abort (); | |
554 | } | |
555 | if (length > 0) | |
556 | incr_ptr += length; | |
557 | else | |
558 | { /* Everything's sent */ | |
559 | XSelectInput (x_current_display, incr_requestor, 0L); | |
560 | incr_requestor = (Window) 0; | |
561 | incr_property = (Atom) 0; | |
562 | incr_nbytes = 0; | |
563 | incr_value = (unsigned char *) 0; | |
564 | incr_ptr = (unsigned char *) 0; | |
565 | x_converting_selection = 0; | |
566 | } | |
567 | } | |
568 | } | |
569 | ||
234a804b JB |
570 | \f |
571 | /* Requesting the value of a selection. */ | |
f3a0bf5c | 572 | |
de02ad0b JB |
573 | static Lisp_Object x_selection_arrival (); |
574 | ||
f3a0bf5c JB |
575 | /* Predicate function used to match a requested event. */ |
576 | ||
577 | Bool | |
578 | XCheckSelectionEvent (dpy, event, window) | |
579 | Display *dpy; | |
580 | XEvent *event; | |
581 | char *window; | |
582 | { | |
583 | if (event->type == SelectionNotify) | |
584 | if (event->xselection.requestor == (Window) window) | |
585 | return True; | |
586 | ||
587 | return False; | |
588 | } | |
589 | ||
3c254570 JA |
590 | /* Request a selection value from its owner. This will block until |
591 | all the data is arrived. */ | |
f3a0bf5c | 592 | |
3c254570 JA |
593 | static Lisp_Object |
594 | get_selection_value (type) | |
595 | Atom type; | |
f3a0bf5c JB |
596 | { |
597 | XEvent event; | |
598 | Lisp_Object val; | |
599 | Time requestor_time; /* Timestamp of selection request. */ | |
600 | Window requestor_window; | |
601 | ||
f3a0bf5c | 602 | BLOCK_INPUT; |
1113d9db | 603 | requestor_time = last_event_timestamp; |
fcb9ffc8 | 604 | requestor_window = FRAME_X_WINDOW (selected_frame); |
3c254570 | 605 | XConvertSelection (x_current_display, type, XA_STRING, |
f3a0bf5c JB |
606 | Xatom_emacs_selection, requestor_window, requestor_time); |
607 | XIfEvent (x_current_display, | |
608 | &event, | |
609 | XCheckSelectionEvent, | |
610 | (char *) requestor_window); | |
611 | val = x_selection_arrival (&event, requestor_window, requestor_time); | |
612 | UNBLOCK_INPUT; | |
613 | ||
614 | return val; | |
615 | } | |
616 | ||
3c254570 JA |
617 | /* Request a selection value from the owner. If we are the owner, |
618 | simply return our selection value. If we are not the owner, this | |
619 | will block until all of the data has arrived. */ | |
f3a0bf5c | 620 | |
dbc4e1c1 JB |
621 | DEFUN ("x-selection", Fx_selection, Sx_selection, |
622 | 1, 1, "", | |
623 | "Return the value of SELECTION.\n\ | |
624 | SELECTION is one of `primary', `secondary', or `clipboard'.\n\ | |
625 | \n\ | |
626 | Selections are a mechanism for cutting and pasting information between\n\ | |
627 | X Windows clients. When the user selects text in an X application,\n\ | |
628 | the application should set the primary selection to that text; Emacs's\n\ | |
629 | kill ring commands will then check the value of the `primary'\n\ | |
630 | selection, and return it as the most recent kill.\n\ | |
631 | The documentation for `x-set-selection' gives more information on how\n\ | |
632 | the different selection types are intended to be used.\n\ | |
633 | Also see the `interprogram-paste-function' variable.") | |
634 | (selection) | |
635 | register Lisp_Object selection; | |
f3a0bf5c | 636 | { |
3c254570 | 637 | Atom selection_type; |
f3a0bf5c | 638 | |
dbc4e1c1 | 639 | if (NILP (selection) || EQ (selection, Qprimary)) |
3c254570 JA |
640 | { |
641 | if (!NILP (Vx_selection_value)) | |
234a804b | 642 | return Vx_selection_value; |
f3a0bf5c | 643 | |
3c254570 JA |
644 | return get_selection_value (XA_PRIMARY); |
645 | } | |
dbc4e1c1 | 646 | else if (EQ (selection, Qsecondary)) |
3c254570 JA |
647 | { |
648 | if (!NILP (Vx_secondary_selection_value)) | |
649 | return Vx_secondary_selection_value; | |
f3a0bf5c | 650 | |
3c254570 JA |
651 | return get_selection_value (XA_SECONDARY); |
652 | } | |
dbc4e1c1 | 653 | else if (EQ (selection, Qclipboard)) |
3c254570 JA |
654 | { |
655 | if (!NILP (Vx_clipboard_value)) | |
656 | return Vx_clipboard_value; | |
657 | ||
658 | return get_selection_value (Xatom_clipboard); | |
659 | } | |
660 | else | |
661 | error ("Invalid X selection type"); | |
f3a0bf5c JB |
662 | } |
663 | ||
de02ad0b | 664 | static Lisp_Object |
f3a0bf5c JB |
665 | x_selection_arrival (event, requestor_window, requestor_time) |
666 | register XSelectionEvent *event; | |
667 | Window requestor_window; | |
668 | Time requestor_time; | |
669 | { | |
670 | int result; | |
671 | Atom type, selection; | |
672 | int format; | |
673 | unsigned long items; | |
674 | unsigned long bytes_left; | |
675 | unsigned char *data = 0; | |
676 | int offset = 0; | |
677 | ||
678 | if (event->selection == XA_PRIMARY) | |
679 | selection = Xatom_emacs_selection; | |
3c254570 JA |
680 | else if (event->selection == XA_SECONDARY) |
681 | selection = Xatom_emacs_secondary_selection; | |
f3a0bf5c JB |
682 | else if (event->selection == Xatom_clipboard) |
683 | selection = Xatom_clipboard_selection; | |
684 | else | |
685 | abort (); | |
686 | ||
687 | if (event->requestor == requestor_window | |
688 | && event->time == requestor_time | |
689 | && event->property != None) | |
690 | if (event->target != Xatom_incremental) | |
691 | { | |
692 | unsigned char *return_string = | |
693 | (unsigned char *) alloca (MAX_SELECTION (x_current_display)); | |
694 | ||
695 | do | |
696 | { | |
3c254570 | 697 | result = XGetWindowProperty (x_current_display, requestor_window, |
f3a0bf5c JB |
698 | event->property, 0L, |
699 | 10000000L, True, XA_STRING, | |
700 | &type, &format, &items, | |
701 | &bytes_left, &data); | |
702 | if (result == Success && type == XA_STRING && format == 8 | |
703 | && offset < MAX_SELECTION (x_current_display)) | |
704 | { | |
705 | bcopy (data, return_string + offset, items); | |
706 | offset += items; | |
707 | } | |
708 | XFree ((char *) data); | |
709 | } | |
710 | while (bytes_left); | |
711 | ||
712 | return make_string (return_string, offset); | |
713 | } | |
714 | else /* Prepare incremental transfer. */ | |
715 | { | |
716 | unsigned char *increment_value; | |
717 | unsigned char *increment_ptr; | |
718 | int total_size; | |
719 | int *increment_nbytes = 0; | |
720 | ||
721 | result = XGetWindowProperty (x_current_display, requestor_window, | |
722 | selection, 0L, 10000000L, False, | |
723 | event->property, &type, &format, | |
724 | &items, &bytes_left, | |
725 | (unsigned char **) &increment_nbytes); | |
726 | if (result == Success) | |
727 | { | |
728 | XPropertyEvent property_event; | |
729 | ||
730 | total_size = *increment_nbytes; | |
731 | increment_value = (unsigned char *) alloca (total_size); | |
732 | increment_ptr = increment_value; | |
733 | ||
734 | XDeleteProperty (x_current_display, event->requestor, | |
735 | event->property); | |
736 | XFlush (x_current_display); | |
737 | XFree ((char *) increment_nbytes); | |
738 | ||
739 | do | |
740 | { /* NOTE: this blocks. */ | |
741 | XWindowEvent (x_current_display, requestor_window, | |
742 | PropertyChangeMask, | |
743 | (XEvent *) &property_event); | |
744 | ||
745 | if (property_event.atom == selection | |
746 | && property_event.state == PropertyNewValue) | |
747 | do | |
748 | { | |
749 | result = XGetWindowProperty (x_current_display, | |
750 | requestor_window, | |
751 | selection, 0L, | |
752 | 10000000L, True, | |
753 | AnyPropertyType, | |
754 | &type, &format, | |
755 | &items, &bytes_left, | |
756 | &data); | |
757 | if (result == Success && type == XA_STRING | |
758 | && format == 8) | |
759 | { | |
760 | bcopy (data, increment_ptr, items); | |
761 | increment_ptr += items; | |
762 | } | |
763 | } | |
764 | while (bytes_left); | |
765 | ||
766 | } | |
767 | while (increment_ptr < (increment_value + total_size)); | |
768 | ||
769 | return make_string (increment_value, | |
770 | (increment_ptr - increment_value)); | |
771 | } | |
772 | } | |
773 | ||
774 | return Qnil; | |
775 | } | |
776 | ||
234a804b JB |
777 | \f |
778 | /* Cut buffer management. */ | |
779 | ||
780 | DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 1, "", | |
781 | "Return the value of cut buffer N, or nil if it is unset.\n\ | |
782 | If N is omitted, it defaults to zero.\n\ | |
783 | Note that cut buffers have some problems that selections don't; try to\n\ | |
784 | write your code to use cut buffers only for backward compatibility,\n\ | |
785 | and use selections for the serious work.") | |
786 | (n) | |
787 | Lisp_Object n; | |
788 | { | |
789 | int buf_num; | |
790 | ||
791 | if (NILP (n)) | |
792 | buf_num = 0; | |
793 | else | |
794 | { | |
795 | CHECK_NUMBER (n, 0); | |
796 | buf_num = XINT (n); | |
797 | } | |
798 | ||
8e6bef18 JB |
799 | if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS) |
800 | error ("cut buffer numbers must be from zero to seven"); | |
234a804b JB |
801 | |
802 | { | |
803 | Lisp_Object value; | |
804 | ||
805 | /* Note that no PropertyNotify events will be processed while | |
806 | input is blocked. */ | |
807 | BLOCK_INPUT; | |
808 | ||
809 | if (cut_buffer_cached & (1 << buf_num)) | |
810 | value = XVECTOR (cut_buffer_value)->contents[buf_num]; | |
811 | else | |
812 | { | |
813 | /* Our cache is invalid; retrieve the property's value from | |
814 | the server. */ | |
815 | int buf_len; | |
816 | char *buf = XFetchBuffer (x_current_display, &buf_len, buf_num); | |
817 | ||
818 | if (buf_len == 0) | |
819 | value = Qnil; | |
820 | else | |
821 | value = make_string (buf, buf_len); | |
822 | ||
823 | XVECTOR (cut_buffer_value)->contents[buf_num] = value; | |
824 | cut_buffer_cached |= (1 << buf_num); | |
825 | ||
826 | XFree (buf); | |
827 | } | |
828 | ||
829 | UNBLOCK_INPUT; | |
830 | ||
831 | return value; | |
832 | } | |
833 | } | |
834 | ||
835 | DEFUN ("x-set-cut-buffer", Fx_set_cut_buffer, Sx_set_cut_buffer, 2, 2, "", | |
836 | "Set the value of cut buffer N to STRING.\n\ | |
837 | Note that cut buffers have some problems that selections don't; try to\n\ | |
838 | write your code to use cut buffers only for backward compatibility,\n\ | |
839 | and use selections for the serious work.") | |
840 | (n, string) | |
841 | Lisp_Object n, string; | |
842 | { | |
843 | int buf_num; | |
844 | ||
845 | CHECK_NUMBER (n, 0); | |
846 | CHECK_STRING (string, 1); | |
847 | ||
848 | buf_num = XINT (n); | |
849 | ||
8e6bef18 JB |
850 | if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS) |
851 | error ("cut buffer numbers must be from zero to seven"); | |
234a804b JB |
852 | |
853 | BLOCK_INPUT; | |
854 | ||
855 | /* DECwindows and some other servers don't seem to like setting | |
856 | properties to values larger than about 20k. For very large | |
857 | values, they signal an error, but for intermediate values they | |
858 | just seem to hang. | |
859 | ||
860 | We could just truncate the request, but it's better to let the | |
861 | user know that the strategy he/she's using isn't going to work | |
862 | than to have it work partially, but incorrectly. */ | |
863 | ||
864 | if (XSTRING (string)->size == 0 | |
865 | || XSTRING (string)->size > MAX_SELECTION (x_current_display)) | |
866 | { | |
867 | XStoreBuffer (x_current_display, (char *) 0, 0, buf_num); | |
868 | string = Qnil; | |
869 | } | |
870 | else | |
871 | { | |
872 | XStoreBuffer (x_current_display, | |
873 | (char *) XSTRING (string)->data, XSTRING (string)->size, | |
874 | buf_num); | |
875 | } | |
876 | ||
877 | XVECTOR (cut_buffer_value)->contents[buf_num] = string; | |
878 | cut_buffer_cached |= (1 << buf_num); | |
879 | cut_buffer_just_set |= (1 << buf_num); | |
880 | ||
881 | UNBLOCK_INPUT; | |
882 | ||
883 | return string; | |
884 | } | |
885 | ||
886 | /* Ask the server to send us an event if any cut buffer is modified. */ | |
887 | ||
888 | void | |
889 | x_watch_cut_buffer_cache () | |
890 | { | |
891 | XSelectInput (x_current_display, ROOT_WINDOW, PropertyChangeMask); | |
892 | } | |
893 | ||
894 | /* The server has told us that a cut buffer has been modified; deal with that. | |
895 | Note that this function is called at interrupt level. */ | |
896 | void | |
897 | x_invalidate_cut_buffer_cache (XPropertyEvent *event) | |
898 | { | |
899 | int i; | |
900 | ||
901 | /* See which cut buffer this is about, if any. */ | |
902 | for (i = 0; i < NUM_CUT_BUFFERS; i++) | |
903 | if (event->atom == cut_buffer_atom[i]) | |
904 | { | |
905 | int mask = (1 << i); | |
906 | ||
907 | if (cut_buffer_just_set & mask) | |
908 | cut_buffer_just_set &= ~mask; | |
909 | else | |
910 | cut_buffer_cached &= ~mask; | |
911 | ||
912 | break; | |
913 | } | |
914 | } | |
915 | ||
916 | \f | |
917 | /* Bureaucracy. */ | |
918 | ||
f3a0bf5c JB |
919 | void |
920 | syms_of_xselect () | |
921 | { | |
922 | DEFVAR_LISP ("x-selection-value", &Vx_selection_value, | |
923 | "The value of emacs' last cut-string."); | |
924 | Vx_selection_value = Qnil; | |
925 | ||
3c254570 JA |
926 | DEFVAR_LISP ("x-secondary-selection-value", &Vx_secondary_selection_value, |
927 | "The value of emacs' last secondary cut-string."); | |
928 | Vx_secondary_selection_value = Qnil; | |
929 | ||
f3a0bf5c JB |
930 | DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value, |
931 | "The string emacs last sent to the clipboard."); | |
932 | Vx_clipboard_value = Qnil; | |
933 | ||
3c254570 JA |
934 | Qprimary = intern ("primary"); |
935 | staticpro (&Qprimary); | |
936 | Qsecondary = intern ("secondary"); | |
937 | staticpro (&Qsecondary); | |
938 | Qclipboard = intern ("clipboard"); | |
939 | staticpro (&Qclipboard); | |
940 | ||
dbc4e1c1 JB |
941 | defsubr (&Sx_set_selection); |
942 | defsubr (&Sx_selection); | |
234a804b JB |
943 | |
944 | cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil); | |
945 | staticpro (&cut_buffer_value); | |
946 | ||
947 | defsubr (&Sx_get_cut_buffer); | |
948 | defsubr (&Sx_set_cut_buffer); | |
f3a0bf5c JB |
949 | } |
950 | #endif /* X11 */ |