src/xselect.c.old

   1 /* X Selection processing for emacs
   2    Copyright (C) 1990, 1992, 1993 Free Software Foundation.
   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
   8 the Free Software Foundation; either version 2, or (at your option)
   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"
  23 #include "buffer.h"
  24 #include "frame.h"
  25
  26 #ifdef HAVE_X11
  27
  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))
  31
  32 /* The timestamp of the last input event we received from the X server.  */
  33 unsigned long last_event_timestamp;
  34
  35 /* t if a mouse button is depressed. */
  36 extern Lisp_Object Vmouse_grabbed;
  37
  38 /* When emacs became the PRIMARY selection owner. */
  39 Time x_begin_selection_own;
  40
  41 /* When emacs became the SECONDARY selection owner. */
  42 Time x_begin_secondary_selection_own;
  43
  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
  53 /* The value of the current SECONDARY selection. */
  54 Lisp_Object Vx_secondary_selection_value;
  55
  56 /* Types of selections we may make.  */
  57 Lisp_Object Qprimary, Qsecondary, Qclipboard;
  58
  59 /* Emacs' selection property identifiers. */
  60 Atom Xatom_emacs_selection;
  61 Atom Xatom_emacs_secondary_selection;
  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
  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
 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
 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.  */
 157
 158
 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;
 165 {
 166   Window owner_window, selecting_window;
 167
 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;
 175
 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);
 180
 181       if (owner_window != selecting_window)
 182     return 0;
 183
 184   return 1;
 185 }
 186
 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. */
 190
 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\
 195 \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\
 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;
 226 {
 227   Atom selection_type;
 228   Lisp_Object val;
 229   Time event_time = last_event_timestamp;
 230   CHECK_STRING (string, 0);
 231
 232   val = Qnil;
 233
 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");
 266
 267   return val;
 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 {
 279   struct frame *s = x_window_to_frame (old_owner);
 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         }
 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. */
 303 }
 304
 305 \f
 306 /* Answering selection requests.  */
 307
 308 int x_selection_alloc_error;
 309 int x_converting_selection;
 310
 311 /* Reply to some client's request for our selection data.
 312    Data is placed in a property supplied by the requesting window.
 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     }
 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 ();
 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
 376       if (event.property == 0   /* 0 == NILP */
 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,
 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 ();
 410
 411       x_disown_selection (event.owner, event.selection, event.time);
 412
 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);
 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);
 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         }
 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
 570 \f
 571 /* Requesting the value of a selection.  */
 572
 573 static Lisp_Object x_selection_arrival ();
 574
 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
 590 /* Request a selection value from its owner.  This will block until
 591    all the data is arrived. */
 592
 593 static Lisp_Object
 594 get_selection_value (type)
 595      Atom type;
 596 {
 597   XEvent event;
 598   Lisp_Object val;
 599   Time requestor_time;          /* Timestamp of selection request. */
 600   Window requestor_window;
 601
 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;
 613
 614   return val;
 615 }
 616
 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. */
 620
 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;
 636 {
 637   Atom selection_type;
 638
 639   if (NILP (selection) || EQ (selection, Qprimary))
 640     {
 641       if (!NILP (Vx_selection_value))
 642         return Vx_selection_value;
 643
 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;
 650
 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;
 657
 658       return get_selection_value (Xatom_clipboard);
 659     }
 660   else
 661     error ("Invalid X selection type");
 662 }
 663
 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;
 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;
 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 ();
 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           {
 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);
 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
 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
 799   if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
 800     error ("cut buffer numbers must be from zero to seven");
 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
 850   if (buf_num < 0 || buf_num >= NUM_CUT_BUFFERS)
 851     error ("cut buffer numbers must be from zero to seven");
 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
 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
 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
 930   DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value,
 931                "The string emacs last sent to the clipboard.");
 932   Vx_clipboard_value = Qnil;
 933
 934   Qprimary = intern ("primary");
 935   staticpro (&Qprimary);
 936   Qsecondary = intern ("secondary");
 937   staticpro (&Qsecondary);
 938   Qclipboard = intern ("clipboard");
 939   staticpro (&Qclipboard);
 940
 941   defsubr (&Sx_set_selection);
 942   defsubr (&Sx_selection);
 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);
 949 }
 950 #endif  /* X11 */