(top level comment): Updated to reflect the fact that
[emacs.git] / src / xselect.c.old
blob8a3e04432705c62d33358175d7aec0822338ced5
1 /* X Selection processing for emacs
2    Copyright (C) 1990, 1992, 1993 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)
9 any later version.
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.  */
20 #include "config.h"
21 #include "lisp.h"
22 #include "xterm.h"
23 #include "buffer.h"
24 #include "frame.h"
26 #ifdef HAVE_X11
28 /* Macros for X Selections */
29 #define MAX_SELECTION(dpy) (((dpy)->max_request_size << 2) - 100)
30 #define SELECTION_LENGTH(len,format) ((len) * ((format) >> 2))
32 /* The timestamp of the last input event we received from the X server.  */
33 unsigned long last_event_timestamp;
35 /* t if a mouse button is depressed. */
36 extern Lisp_Object Vmouse_grabbed;
38 /* When emacs became the PRIMARY selection owner. */
39 Time x_begin_selection_own;
41 /* When emacs became the SECONDARY selection owner. */
42 Time x_begin_secondary_selection_own;
44 /* When emacs became the CLIPBOARD selection owner. */
45 Time x_begin_clipboard_own;
47 /* The value of the current CLIPBOARD selection. */
48 Lisp_Object Vx_clipboard_value;
50 /* The value of the current PRIMARY selection. */
51 Lisp_Object Vx_selection_value;
53 /* The value of the current SECONDARY selection. */
54 Lisp_Object Vx_secondary_selection_value;
56 /* Types of selections we may make.  */
57 Lisp_Object Qprimary, Qsecondary, Qclipboard;
59 /* Emacs' selection property identifiers. */
60 Atom Xatom_emacs_selection;
61 Atom Xatom_emacs_secondary_selection;
63 /* Clipboard selection atom. */
64 Atom Xatom_clipboard_selection;
66 /* Clipboard atom. */
67 Atom Xatom_clipboard;
69 /* Atom for indicating incremental selection transfer. */
70 Atom Xatom_incremental;
72 /* Atom for indicating multiple selection request list */
73 Atom Xatom_multiple;
75 /* Atom for what targets emacs handles. */
76 Atom Xatom_targets;
78 /* Atom for indicating timstamp selection request */
79 Atom Xatom_timestamp;
81 /* Atom requesting we delete our selection. */
82 Atom Xatom_delete;
84 /* Selection magic. */
85 Atom Xatom_insert_selection;
87 /* Type of property for INSERT_SELECTION. */
88 Atom Xatom_pair;
90 /* More selection magic. */
91 Atom Xatom_insert_property;
93 /* Atom for indicating property type TEXT */
94 Atom Xatom_text;
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;
101 /* Communication with window managers. */
102 Atom Xatom_wm_protocols;
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;
111 /* Declarations for handling cut buffers.
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.
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.  */
125 /* The number of CUT_BUFFER properties defined under X.  */
126 #define NUM_CUT_BUFFERS (8)
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
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;
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.
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;
156 /* Acquiring ownership of a selection.  */
159 /* Request selection ownership if we do not already have it. */
161 static int
162 own_selection (selection_type, time)
163      Atom selection_type;
164      Time time;
166   Window owner_window, selecting_window;
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)))
174     return 1;
176   selecting_window = FRAME_X_WINDOW (selected_frame);
177   XSetSelectionOwner (x_current_display, selection_type,
178                       selecting_window, time);
179   owner_window = XGetSelectionOwner (x_current_display, selection_type);
181       if (owner_window != selecting_window)
182     return 0;
184   return 1;
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. */
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\
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\
202 According to the Inter-Client Communications Conventions Manual:\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\
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\
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\
223 Also see `x-selection', and the `interprogram-cut-function' variable.")
224   (selection, string)
225      register Lisp_Object selection, string;
227   Atom selection_type;
228   Lisp_Object val;
229   Time event_time = last_event_timestamp;
230   CHECK_STRING (string, 0);
232   val = Qnil;
234   if (NILP (selection) || EQ (selection, Qprimary))
235     {
236       BLOCK_INPUT;
237       if (own_selection (XA_PRIMARY, event_time))
238         {
239           x_begin_selection_own = event_time;
240           val = Vx_selection_value = string;
241         }
242       UNBLOCK_INPUT;
243     }
244   else if (EQ (selection, Qsecondary))
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     }
254   else if (EQ (selection, Qclipboard))
255     {
256       BLOCK_INPUT;
257       if (own_selection (Xatom_clipboard, event_time))
258         {
259           x_begin_clipboard_own = event_time;
260           val = Vx_clipboard_value = string;
261         }
262       UNBLOCK_INPUT;
263     }
264   else
265     error ("Invalid X selection type");
267   return val;
270 /* Clear our selection ownership data, as some other client has
271    become the owner. */
273 void
274 x_disown_selection (old_owner, selection, changed_owner_time)
275      Window *old_owner;
276      Atom selection;
277      Time changed_owner_time;
279   struct frame *s = x_window_to_frame (old_owner);
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         }
288       else if (selection == XA_SECONDARY)
289         {
290           x_begin_secondary_selection_own = 0;
291           Vx_secondary_selection_value = Qnil;
292         }
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. */
306 /* Answering selection requests.  */
308 int x_selection_alloc_error;
309 int x_converting_selection;
311 /* Reply to some client's request for our selection data.
312    Data is placed in a property supplied by the requesting window.
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.
318    But first, check for all the other crufty stuff we could get. */
320 void
321 x_answer_selection_request (event)
322      XSelectionRequestEvent event;
324   Time emacs_own_time;
325   Lisp_Object selection_value;
326   XSelectionEvent evt;
327   int format = 8;               /* We have only byte sized (text) data. */
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;
336   if (event.selection == XA_PRIMARY)
337     {
338       emacs_own_time = x_begin_selection_own;
339       selection_value = Vx_selection_value;
340     }
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     }
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 ();
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     }
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;
376       if (event.property == 0   /* 0 == NILP */
377           || event.property == None)
378         return;
380       result = XGetWindowProperty (event.display, event.requestor,
381                                    event.property, 0L, 10000000L,
382                                    True, Xatom_pair, &type, &return_format,
383                                    &items, &bytes_left, &data);
385       if (result == Success && type == Xatom_pair)
386         for (i = items; i > 0; i--)
387           {
388             /* Convert each element of the list. */
389           }
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 ();
400       format = 32;
401       XChangeProperty (evt.display, evt.requestor, evt.property,
402                        evt.target, format, PropModeReplace,
403                        (unsigned char *) &emacs_own_time, 1);
404       return;
405     }
406   else if (event.target == Xatom_delete)      /* Delete our selection. */
407     {
408       if (EQ (Qnil, selection_value))
409         abort ();
411       x_disown_selection (event.owner, event.selection, event.time);
413       /* Now return property of type NILP, length 0. */
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);
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);
449           else if (event.selection == Xatom_emacs_secondary_selection)
450             Vx_secondary_selection_value = make_string (data);
451           else if (event.selection == Xatom_clipboard_selection)
452             Vx_clipboard_value = make_string (data);
453           else
454             abort ();
455         }
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 ();
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;
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             }
503           incr_nbytes = size;
504           incr_value = data;
505           incr_ptr = data;
507           /* Ask for notification when requestor deletes property. */
508           XSelectInput (x_current_display, incr_requestor, PropertyChangeMask);
510           /* If we're sending incrementally, perhaps block here
511              until all sent? */
512         }
513     }
514   else
515     evt.property = None;
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);
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.
528    When there is no more data to send, we send a zero-length increment. */
530 void
531 x_send_incremental (event)
532      XPropertyEvent event;
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     }
571 /* Requesting the value of a selection.  */
573 static Lisp_Object x_selection_arrival ();
575 /* Predicate function used to match a requested event. */
577 Bool
578 XCheckSelectionEvent (dpy, event, window)
579      Display *dpy;
580      XEvent *event;
581      char *window;
583   if (event->type == SelectionNotify)
584     if (event->xselection.requestor == (Window) window)
585       return True;
587   return False;
590 /* Request a selection value from its owner.  This will block until
591    all the data is arrived. */
593 static Lisp_Object
594 get_selection_value (type)
595      Atom type;
597   XEvent event;
598   Lisp_Object val;
599   Time requestor_time;          /* Timestamp of selection request. */
600   Window requestor_window;
602   BLOCK_INPUT;
603   requestor_time = last_event_timestamp;
604   requestor_window = FRAME_X_WINDOW (selected_frame);
605   XConvertSelection (x_current_display, type, XA_STRING,
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;
614   return val;
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. */
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\
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;
637   Atom selection_type;
639   if (NILP (selection) || EQ (selection, Qprimary))
640     {
641       if (!NILP (Vx_selection_value))
642         return Vx_selection_value;
644       return get_selection_value (XA_PRIMARY);
645     }
646   else if (EQ (selection, Qsecondary))
647     {
648       if (!NILP (Vx_secondary_selection_value))
649         return Vx_secondary_selection_value;
651       return get_selection_value (XA_SECONDARY);
652     }
653   else if (EQ (selection, Qclipboard))
654     {
655       if (!NILP (Vx_clipboard_value))
656         return Vx_clipboard_value;
658       return get_selection_value (Xatom_clipboard);
659     }
660   else
661     error ("Invalid X selection type");
664 static Lisp_Object
665 x_selection_arrival (event, requestor_window, requestor_time)
666      register XSelectionEvent *event;
667      Window requestor_window;
668      Time requestor_time;
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;
678   if (event->selection == XA_PRIMARY)
679     selection = Xatom_emacs_selection;
680   else if (event->selection == XA_SECONDARY)
681     selection = Xatom_emacs_secondary_selection;
682   else if (event->selection == Xatom_clipboard)
683     selection = Xatom_clipboard_selection;
684   else
685     abort ();
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));
695         do
696           {
697             result = XGetWindowProperty (x_current_display, requestor_window,
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);
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;
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;
730             total_size = *increment_nbytes;
731             increment_value = (unsigned char *) alloca (total_size);
732             increment_ptr = increment_value;
734             XDeleteProperty (x_current_display, event->requestor,
735                              event->property);
736             XFlush (x_current_display);
737             XFree ((char *) increment_nbytes);
739             do
740               {                 /* NOTE: this blocks. */
741                 XWindowEvent (x_current_display, requestor_window,
742                               PropertyChangeMask,
743                               (XEvent *) &property_event);
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);
766               }
767             while (increment_ptr < (increment_value + total_size));
769             return make_string (increment_value,
770                                 (increment_ptr - increment_value));
771           }
772       }
774   return Qnil;
778 /* Cut buffer management.  */
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;
789   int buf_num;
791   if (NILP (n))
792     buf_num = 0;
793   else
794     {
795       CHECK_NUMBER (n, 0);
796       buf_num = XINT (n);
797     }
799   if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
800     error ("cut buffer numbers must be from zero to seven");
802   {
803     Lisp_Object value;
805     /* Note that no PropertyNotify events will be processed while
806        input is blocked.  */
807     BLOCK_INPUT;
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);
818         if (buf_len == 0)
819           value = Qnil;
820         else
821           value = make_string (buf, buf_len);
823         XVECTOR (cut_buffer_value)->contents[buf_num] = value;
824         cut_buffer_cached |= (1 << buf_num);
826         XFree (buf);
827       }
829     UNBLOCK_INPUT;
831     return value;
832   }
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;
843   int buf_num;
845   CHECK_NUMBER (n, 0);
846   CHECK_STRING (string, 1);
848   buf_num = XINT (n);
850   if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
851     error ("cut buffer numbers must be from zero to seven");
853   BLOCK_INPUT;
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.
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.  */
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     }
877   XVECTOR (cut_buffer_value)->contents[buf_num] = string;
878   cut_buffer_cached |= (1 << buf_num);
879   cut_buffer_just_set |= (1 << buf_num);
881   UNBLOCK_INPUT;
883   return string;
886 /* Ask the server to send us an event if any cut buffer is modified.  */
888 void
889 x_watch_cut_buffer_cache ()
891   XSelectInput (x_current_display, ROOT_WINDOW, PropertyChangeMask);
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)
899   int i;
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);
907         if (cut_buffer_just_set & mask)
908           cut_buffer_just_set &= ~mask;
909         else
910           cut_buffer_cached &= ~mask;
912         break;
913       }
917 /* Bureaucracy.  */
919 void
920 syms_of_xselect ()
922   DEFVAR_LISP ("x-selection-value", &Vx_selection_value,
923                "The value of emacs' last cut-string.");
924   Vx_selection_value = Qnil;
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;
930   DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value,
931                "The string emacs last sent to the clipboard.");
932   Vx_clipboard_value = Qnil;
934   Qprimary = intern ("primary");
935   staticpro (&Qprimary);
936   Qsecondary = intern ("secondary");
937   staticpro (&Qsecondary);
938   Qclipboard = intern ("clipboard");
939   staticpro (&Qclipboard);
941   defsubr (&Sx_set_selection);
942   defsubr (&Sx_selection);
944   cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil);
945   staticpro (&cut_buffer_value);
947   defsubr (&Sx_get_cut_buffer);
948   defsubr (&Sx_set_cut_buffer);
950 #endif  /* X11 */