home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / emacs-19.28-src.tgz / tar.out / fsf / emacs / src / xselect.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  64KB  |  2,092 lines
  1. /* X Selection processing for emacs
  2.    Copyright (C) 1993, 1994 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. /* x_handle_selection_notify
  21. x_reply_selection_request  */
  22.  
  23.  
  24. /* Rewritten by jwz */
  25.  
  26. #include <config.h>
  27. #include "lisp.h"
  28. #if 0
  29. #include <stdio.h>    /* termhooks.h needs this */
  30. #include "termhooks.h"
  31. #endif
  32. #include "xterm.h"    /* for all of the X includes */
  33. #include "dispextern.h"    /* frame.h seems to want this */
  34. #include "frame.h"    /* Need this to get the X window of selected_frame */
  35. #include "blockinput.h"
  36.  
  37. #define xfree free
  38.  
  39. #define CUT_BUFFER_SUPPORT
  40.  
  41. static Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE,
  42.   Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL,
  43.   Xatom_ATOM_PAIR;
  44.  
  45. Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  46.   QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  47.   QATOM_PAIR;
  48.  
  49. #ifdef CUT_BUFFER_SUPPORT
  50. Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  51.   QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
  52. #endif
  53.  
  54. Lisp_Object Vx_lost_selection_hooks;
  55. Lisp_Object Vx_sent_selection_hooks;
  56.  
  57. /* If this is a smaller number than the max-request-size of the display,
  58.    emacs will use INCR selection transfer when the selection is larger
  59.    than this.  The max-request-size is usually around 64k, so if you want
  60.    emacs to use incremental selection transfers when the selection is 
  61.    smaller than that, set this.  I added this mostly for debugging the
  62.    incremental transfer stuff, but it might improve server performance.
  63.  */
  64. #define MAX_SELECTION_QUANTUM 0xFFFFFF
  65.  
  66. #ifdef HAVE_X11R4
  67. #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
  68. #else
  69. #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
  70. #endif
  71.  
  72. /* The timestamp of the last input event Emacs received from the X server.  */
  73. unsigned long last_event_timestamp;
  74.  
  75. /* This is an association list whose elements are of the form
  76.      ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
  77.    SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
  78.    SELECTION-VALUE is the value that emacs owns for that selection.
  79.      It may be any kind of Lisp object.
  80.    SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
  81.      as a cons of two 16-bit numbers (making a 32 bit time.)
  82.    FRAME is the frame for which we made the selection.
  83.    If there is an entry in this alist, then it can be assumed that Emacs owns
  84.     that selection.
  85.    The only (eq) parts of this list that are visible from Lisp are the
  86.     selection-values.
  87.  */
  88. Lisp_Object Vselection_alist;
  89.  
  90. /* This is an alist whose CARs are selection-types (whose names are the same
  91.    as the names of X Atoms) and whose CDRs are the names of Lisp functions to
  92.    call to convert the given Emacs selection value to a string representing 
  93.    the given selection type.  This is for Lisp-level extension of the emacs
  94.    selection handling.
  95.  */
  96. Lisp_Object Vselection_converter_alist;
  97.  
  98. /* If the selection owner takes too long to reply to a selection request,
  99.    we give up on it.  This is in milliseconds (0 = no timeout.)
  100.  */
  101. int x_selection_timeout;
  102.  
  103. /* Utility functions */
  104.  
  105. static void lisp_data_to_selection_data ();
  106. static Lisp_Object selection_data_to_lisp_data ();
  107. static Lisp_Object x_get_window_property_as_lisp_data ();
  108.  
  109. /* This converts a Lisp symbol to a server Atom, avoiding a server 
  110.    roundtrip whenever possible.  */
  111.  
  112. static Atom
  113. symbol_to_x_atom (display, sym)
  114.      Display *display;
  115.      Lisp_Object sym;
  116. {
  117.   Atom val;
  118.   if (NILP (sym))        return 0;
  119.   if (EQ (sym, QPRIMARY))   return XA_PRIMARY;
  120.   if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
  121.   if (EQ (sym, QSTRING))    return XA_STRING;
  122.   if (EQ (sym, QINTEGER))   return XA_INTEGER;
  123.   if (EQ (sym, QATOM))        return XA_ATOM;
  124.   if (EQ (sym, QCLIPBOARD)) return Xatom_CLIPBOARD;
  125.   if (EQ (sym, QTIMESTAMP)) return Xatom_TIMESTAMP;
  126.   if (EQ (sym, QTEXT))        return Xatom_TEXT;
  127.   if (EQ (sym, QDELETE))    return Xatom_DELETE;
  128.   if (EQ (sym, QMULTIPLE))  return Xatom_MULTIPLE;
  129.   if (EQ (sym, QINCR))        return Xatom_INCR;
  130.   if (EQ (sym, QEMACS_TMP)) return Xatom_EMACS_TMP;
  131.   if (EQ (sym, QTARGETS))   return Xatom_TARGETS;
  132.   if (EQ (sym, QNULL))        return Xatom_NULL;
  133. #ifdef CUT_BUFFER_SUPPORT
  134.   if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
  135.   if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
  136.   if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
  137.   if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
  138.   if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
  139.   if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
  140.   if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
  141.   if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
  142. #endif
  143.   if (!SYMBOLP (sym)) abort ();
  144.  
  145. #if 0
  146.   fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
  147. #endif
  148.   BLOCK_INPUT;
  149.   val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
  150.   UNBLOCK_INPUT;
  151.   return val;
  152. }
  153.  
  154.  
  155. /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
  156.    and calls to intern whenever possible.  */
  157.  
  158. static Lisp_Object
  159. x_atom_to_symbol (display, atom)
  160.      Display *display;
  161.      Atom atom;
  162. {
  163.   char *str;
  164.   Lisp_Object val;
  165.   if (! atom) return Qnil;
  166.   switch (atom)
  167.     {
  168.     case XA_PRIMARY:
  169.       return QPRIMARY;
  170.     case XA_SECONDARY:
  171.       return QSECONDARY;
  172.     case XA_STRING:
  173.       return QSTRING;
  174.     case XA_INTEGER:
  175.       return QINTEGER;
  176.     case XA_ATOM:
  177.       return QATOM;
  178. #ifdef CUT_BUFFER_SUPPORT
  179.     case XA_CUT_BUFFER0:
  180.       return QCUT_BUFFER0;
  181.     case XA_CUT_BUFFER1:
  182.       return QCUT_BUFFER1;
  183.     case XA_CUT_BUFFER2:
  184.       return QCUT_BUFFER2;
  185.     case XA_CUT_BUFFER3:
  186.       return QCUT_BUFFER3;
  187.     case XA_CUT_BUFFER4:
  188.       return QCUT_BUFFER4;
  189.     case XA_CUT_BUFFER5:
  190.       return QCUT_BUFFER5;
  191.     case XA_CUT_BUFFER6:
  192.       return QCUT_BUFFER6;
  193.     case XA_CUT_BUFFER7:
  194.       return QCUT_BUFFER7;
  195. #endif
  196.     }
  197.  
  198.   if (atom == Xatom_CLIPBOARD)
  199.     return QCLIPBOARD;
  200.   if (atom == Xatom_TIMESTAMP)
  201.     return QTIMESTAMP;
  202.   if (atom == Xatom_TEXT)
  203.     return QTEXT;
  204.   if (atom == Xatom_DELETE)
  205.     return QDELETE;
  206.   if (atom == Xatom_MULTIPLE)
  207.     return QMULTIPLE;
  208.   if (atom == Xatom_INCR)
  209.     return QINCR;
  210.   if (atom == Xatom_EMACS_TMP)
  211.     return QEMACS_TMP;
  212.   if (atom == Xatom_TARGETS)
  213.     return QTARGETS;
  214.   if (atom == Xatom_NULL)
  215.     return QNULL;
  216.  
  217.   BLOCK_INPUT;
  218.   str = XGetAtomName (display, atom);
  219.   UNBLOCK_INPUT;
  220. #if 0
  221.   fprintf (stderr, " XGetAtomName --> %s\n", str);
  222. #endif
  223.   if (! str) return Qnil;
  224.   val = intern (str);
  225.   BLOCK_INPUT;
  226.   XFree (str);
  227.   UNBLOCK_INPUT;
  228.   return val;
  229. }
  230.  
  231. /* Do protocol to assert ourself as a selection owner.
  232.    Update the Vselection_alist so that we can reply to later requests for 
  233.    our selection.  */
  234.  
  235. static void
  236. x_own_selection (selection_name, selection_value)
  237.      Lisp_Object selection_name, selection_value;
  238. {
  239.   Display *display = x_current_display;
  240.   Window selecting_window = FRAME_X_WINDOW (selected_frame);
  241.   Time time = last_event_timestamp;
  242.   Atom selection_atom;
  243.  
  244.   CHECK_SYMBOL (selection_name, 0);
  245.   selection_atom = symbol_to_x_atom (display, selection_name);
  246.  
  247.   BLOCK_INPUT;
  248.   x_catch_errors ();
  249.   XSetSelectionOwner (display, selection_atom, selecting_window, time);
  250.   x_check_errors ("Can't set selection: %s");
  251.   x_uncatch_errors ();
  252.   UNBLOCK_INPUT;
  253.  
  254.   /* Now update the local cache */
  255.   {
  256.     Lisp_Object selection_time;
  257.     Lisp_Object selection_data;
  258.     Lisp_Object prev_value;
  259.  
  260.     selection_time = long_to_cons ((unsigned long) time);
  261.     selection_data = Fcons (selection_name,
  262.                 Fcons (selection_value,
  263.                    Fcons (selection_time,
  264.                       Fcons (Fselected_frame (), Qnil))));
  265.     prev_value = assq_no_quit (selection_name, Vselection_alist);
  266.  
  267.     Vselection_alist = Fcons (selection_data, Vselection_alist);
  268.  
  269.     /* If we already owned the selection, remove the old selection data.
  270.        Perhaps we should destructively modify it instead.
  271.        Don't use Fdelq as that may QUIT.  */
  272.     if (!NILP (prev_value))
  273.       {
  274.     Lisp_Object rest;    /* we know it's not the CAR, so it's easy.  */
  275.     for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
  276.       if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
  277.         {
  278.           XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
  279.           break;
  280.         }
  281.       }
  282.   }
  283. }
  284.  
  285. /* Given a selection-name and desired type, look up our local copy of
  286.    the selection value and convert it to the type.
  287.    The value is nil or a string.
  288.    This function is used both for remote requests
  289.    and for local x-get-selection-internal.
  290.  
  291.    This calls random Lisp code, and may signal or gc.  */
  292.  
  293. static Lisp_Object
  294. x_get_local_selection (selection_symbol, target_type)
  295.      Lisp_Object selection_symbol, target_type;
  296. {
  297.   Lisp_Object local_value;
  298.   Lisp_Object handler_fn, value, type, check;
  299.   int count;
  300.  
  301.   local_value = assq_no_quit (selection_symbol, Vselection_alist);
  302.  
  303.   if (NILP (local_value)) return Qnil;
  304.  
  305.   /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest.  */
  306.   if (EQ (target_type, QTIMESTAMP))
  307.     {
  308.       handler_fn = Qnil;
  309.       value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
  310.     }
  311. #if 0
  312.   else if (EQ (target_type, QDELETE))
  313.     {
  314.       handler_fn = Qnil;
  315.       Fx_disown_selection_internal
  316.     (selection_symbol,
  317.      XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
  318.       value = QNULL;
  319.     }
  320. #endif
  321.  
  322. #if 0 /* #### MULTIPLE doesn't work yet */
  323.   else if (CONSP (target_type)
  324.        && XCONS (target_type)->car == QMULTIPLE)
  325.     {
  326.       Lisp_Object pairs;
  327.       int size;
  328.       int i;
  329.       pairs = XCONS (target_type)->cdr;
  330.       size = XVECTOR (pairs)->size;
  331.       /* If the target is MULTIPLE, then target_type looks like
  332.       (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
  333.      We modify the second element of each pair in the vector and
  334.      return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
  335.        */
  336.       for (i = 0; i < size; i++)
  337.     {
  338.       Lisp_Object pair;
  339.       pair = XVECTOR (pairs)->contents [i];
  340.       XVECTOR (pair)->contents [1]
  341.         = x_get_local_selection (XVECTOR (pair)->contents [0],
  342.                      XVECTOR (pair)->contents [1]);
  343.     }
  344.       return pairs;
  345.     }
  346. #endif
  347.   else
  348.     {
  349.       /* Don't allow a quit within the converter.
  350.      When the user types C-g, he would be surprised
  351.      if by luck it came during a converter.  */
  352.       count = specpdl_ptr - specpdl;
  353.       specbind (Qinhibit_quit, Qt);
  354.  
  355.       CHECK_SYMBOL (target_type, 0);
  356.       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
  357.       if (!NILP (handler_fn))
  358.     value = call3 (handler_fn,
  359.                selection_symbol, target_type,
  360.                XCONS (XCONS (local_value)->cdr)->car);
  361.       else
  362.     value = Qnil;
  363.       unbind_to (count, Qnil);
  364.     }
  365.  
  366.   /* Make sure this value is of a type that we could transmit
  367.      to another X client.  */
  368.  
  369.   check = value;
  370.   if (CONSP (value)
  371.       && SYMBOLP (XCONS (value)->car))
  372.     type = XCONS (value)->car,
  373.     check = XCONS (value)->cdr;
  374.   
  375.   if (STRINGP (check)
  376.       || VECTORP (check)
  377.       || SYMBOLP (check)
  378.       || INTEGERP (check)
  379.       || NILP (value))
  380.     return value;
  381.   /* Check for a value that cons_to_long could handle.  */
  382.   else if (CONSP (check)
  383.        && INTEGERP (XCONS (check)->car)
  384.        && (INTEGERP (XCONS (check)->cdr)
  385.            ||
  386.            (CONSP (XCONS (check)->cdr)
  387.         && INTEGERP (XCONS (XCONS (check)->cdr)->car)
  388.         && NILP (XCONS (XCONS (check)->cdr)->cdr))))
  389.     return value;
  390.   else
  391.     return
  392.       Fsignal (Qerror,
  393.            Fcons (build_string ("invalid data returned by selection-conversion function"),
  394.               Fcons (handler_fn, Fcons (value, Qnil))));
  395. }
  396.  
  397. /* Subroutines of x_reply_selection_request.  */
  398.  
  399. /* Send a SelectionNotify event to the requestor with property=None,
  400.    meaning we were unable to do what they wanted.  */
  401.  
  402. static void
  403. x_decline_selection_request (event)
  404.      struct input_event *event;
  405. {
  406.   XSelectionEvent reply;
  407.   reply.type = SelectionNotify;
  408.   reply.display = SELECTION_EVENT_DISPLAY (event);
  409.   reply.requestor = SELECTION_EVENT_REQUESTOR (event);
  410.   reply.selection = SELECTION_EVENT_SELECTION (event);
  411.   reply.time = SELECTION_EVENT_TIME (event);
  412.   reply.target = SELECTION_EVENT_TARGET (event);
  413.   reply.property = None;
  414.  
  415.   BLOCK_INPUT;
  416.   XSendEvent (reply.display, reply.requestor, False, 0L,
  417.           (XEvent *) &reply);
  418.   XFlushQueue ();
  419.   UNBLOCK_INPUT;
  420. }
  421.  
  422. /* This is the selection request currently being processed.
  423.    It is set to zero when the request is fully processed.  */
  424. static struct input_event *x_selection_current_request;
  425.  
  426. /* Used as an unwind-protect clause so that, if a selection-converter signals
  427.    an error, we tell the requestor that we were unable to do what they wanted
  428.    before we throw to top-level or go into the debugger or whatever.  */
  429.  
  430. static Lisp_Object
  431. x_selection_request_lisp_error (ignore)
  432.      Lisp_Object ignore;
  433. {
  434.   if (x_selection_current_request != 0)
  435.     x_decline_selection_request (x_selection_current_request);
  436.   return Qnil;
  437. }
  438.  
  439.  
  440. /* This stuff is so that INCR selections are reentrant (that is, so we can
  441.    be servicing multiple INCR selection requests simultaneously.)  I haven't
  442.    actually tested that yet.  */
  443.  
  444. /* Keep a list of the property changes that are awaited.  */
  445.  
  446. struct prop_location
  447. {
  448.   int identifier;
  449.   Display *display;
  450.   Window window;
  451.   Atom property;
  452.   int desired_state;
  453.   int arrived;
  454.   struct prop_location *next;
  455. };
  456.  
  457. static struct prop_location *expect_property_change ();
  458. static void wait_for_property_change ();
  459. static void unexpect_property_change ();
  460. static int waiting_for_other_props_on_window ();
  461.  
  462. static int prop_location_identifier;
  463.  
  464. static Lisp_Object property_change_reply;
  465.  
  466. static struct prop_location *property_change_reply_object;
  467.  
  468. static struct prop_location *property_change_wait_list;
  469.  
  470. /* Send the reply to a selection request event EVENT.
  471.    TYPE is the type of selection data requested.
  472.    DATA and SIZE describe the data to send, already converted.
  473.    FORMAT is the unit-size (in bits) of the data to be transmitted.  */
  474.  
  475. static void
  476. x_reply_selection_request (event, format, data, size, type)
  477.      struct input_event *event;
  478.      int format, size;
  479.      unsigned char *data;
  480.      Atom type;
  481. {
  482.   XSelectionEvent reply;
  483.   Display *display = SELECTION_EVENT_DISPLAY (event);
  484.   Window window = SELECTION_EVENT_REQUESTOR (event);
  485.   int bytes_remaining;
  486.   int format_bytes = format/8;
  487.   int max_bytes = SELECTION_QUANTUM (display);
  488.  
  489.   if (max_bytes > MAX_SELECTION_QUANTUM)
  490.     max_bytes = MAX_SELECTION_QUANTUM;
  491.  
  492.   reply.type = SelectionNotify;
  493.   reply.display = display;
  494.   reply.requestor = window;
  495.   reply.selection = SELECTION_EVENT_SELECTION (event);
  496.   reply.time = SELECTION_EVENT_TIME (event);
  497.   reply.target = SELECTION_EVENT_TARGET (event);
  498.   reply.property = SELECTION_EVENT_PROPERTY (event);
  499.   if (reply.property == None)
  500.     reply.property = reply.target;
  501.  
  502.   /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
  503.  
  504.   /* Store the data on the requested property.
  505.      If the selection is large, only store the first N bytes of it.
  506.    */
  507.   bytes_remaining = size * format_bytes;
  508.   if (bytes_remaining <= max_bytes)
  509.     {
  510.       /* Send all the data at once, with minimal handshaking.  */
  511. #if 0
  512.       fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
  513. #endif
  514.       BLOCK_INPUT;
  515.       XChangeProperty (display, window, reply.property, type, format,
  516.                PropModeReplace, data, size);
  517.       /* At this point, the selection was successfully stored; ack it.  */
  518.       XSendEvent (display, window, False, 0L, (XEvent *) &reply);
  519.       XFlushQueue ();
  520.       UNBLOCK_INPUT;
  521.     }
  522.   else
  523.     {
  524.       /* Send an INCR selection.  */
  525.       struct prop_location *wait_object;
  526.  
  527.       BLOCK_INPUT;
  528.  
  529.       if (x_window_to_frame (window)) /* #### debug */
  530.     error ("attempt to transfer an INCR to ourself!");
  531. #if 0
  532.       fprintf (stderr, "\nINCR %d\n", bytes_remaining);
  533. #endif
  534.       wait_object = expect_property_change (display, window, reply.property,
  535.                         PropertyDelete);
  536.  
  537.       XChangeProperty (display, window, reply.property, Xatom_INCR,
  538.                32, PropModeReplace, (unsigned char *)
  539.                &bytes_remaining, 1);
  540.       XSelectInput (display, window, PropertyChangeMask);
  541.       /* Tell 'em the INCR data is there...  */
  542.       (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
  543.       XFlushQueue ();
  544.       UNBLOCK_INPUT;
  545.  
  546.       /* First, wait for the requestor to ack by deleting the property.
  547.      This can run random lisp code (process handlers) or signal.  */
  548.       wait_for_property_change (wait_object);
  549.  
  550.       while (bytes_remaining)
  551.     {
  552.       int i = ((bytes_remaining < max_bytes)
  553.            ? bytes_remaining
  554.            : max_bytes);
  555.  
  556.       BLOCK_INPUT;
  557.  
  558.       wait_object
  559.         = expect_property_change (display, window, reply.property,
  560.                       PropertyDelete);
  561. #if 0
  562.       fprintf (stderr,"  INCR adding %d\n", i);
  563. #endif
  564.       /* Append the next chunk of data to the property.  */
  565.       XChangeProperty (display, window, reply.property, type, format,
  566.                PropModeAppend, data, i / format_bytes);
  567.       bytes_remaining -= i;
  568.       data += i;
  569.       XFlushQueue ();
  570.       UNBLOCK_INPUT;
  571.  
  572.       /* Now wait for the requestor to ack this chunk by deleting the
  573.          property.     This can run random lisp code or signal.
  574.        */
  575.       wait_for_property_change (wait_object);
  576.     }
  577.       /* Now write a zero-length chunk to the property to tell the requestor
  578.      that we're done.  */
  579. #if 0
  580.       fprintf (stderr,"  INCR done\n");
  581. #endif
  582.       BLOCK_INPUT;
  583.       if (! waiting_for_other_props_on_window (display, window))
  584.     XSelectInput (display, window, 0L);
  585.  
  586.       XChangeProperty (display, window, reply.property, type, format,
  587.                PropModeReplace, data, 0);
  588.       XFlushQueue ();
  589.       UNBLOCK_INPUT;
  590.     }
  591. }
  592.  
  593. /* Handle a SelectionRequest event EVENT.
  594.    This is called from keyboard.c when such an event is found in the queue.  */
  595.  
  596. void
  597. x_handle_selection_request (event)
  598.      struct input_event *event;
  599. {
  600.   struct gcpro gcpro1, gcpro2, gcpro3;
  601.   Lisp_Object local_selection_data;
  602.   Lisp_Object selection_symbol;
  603.   Lisp_Object target_symbol;
  604.   Lisp_Object converted_selection;
  605.   Time local_selection_time;
  606.   Lisp_Object successful_p;
  607.   int count;
  608.  
  609.   local_selection_data = Qnil;
  610.   target_symbol = Qnil;
  611.   converted_selection = Qnil;
  612.   successful_p = Qnil;
  613.  
  614.   GCPRO3 (local_selection_data, converted_selection, target_symbol);
  615.  
  616.   selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
  617.                        SELECTION_EVENT_SELECTION (event));
  618.  
  619.   local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
  620.  
  621.   if (NILP (local_selection_data))
  622.     {
  623.       /* Someone asked for the selection, but we don't have it any more.
  624.        */
  625.       x_decline_selection_request (event);
  626.       goto DONE;
  627.     }
  628.  
  629.   local_selection_time = (Time)
  630.     cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
  631.  
  632.   if (SELECTION_EVENT_TIME (event) != CurrentTime
  633.       && local_selection_time > SELECTION_EVENT_TIME (event))
  634.     {
  635.       /* Someone asked for the selection, and we have one, but not the one
  636.      they're looking for.
  637.        */
  638.       x_decline_selection_request (event);
  639.       goto DONE;
  640.     }
  641.  
  642.   count = specpdl_ptr - specpdl;
  643.   x_selection_current_request = event;
  644.   record_unwind_protect (x_selection_request_lisp_error, Qnil);
  645.  
  646.   target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
  647.                     SELECTION_EVENT_TARGET (event));
  648.  
  649. #if 0 /* #### MULTIPLE doesn't work yet */
  650.   if (EQ (target_symbol, QMULTIPLE))
  651.     target_symbol = fetch_multiple_target (event);
  652. #endif
  653.   
  654.   /* Convert lisp objects back into binary data */
  655.   
  656.   converted_selection
  657.     = x_get_local_selection (selection_symbol, target_symbol);
  658.   
  659.   if (! NILP (converted_selection))
  660.     {
  661.       unsigned char *data;
  662.       unsigned int size;
  663.       int format;
  664.       Atom type;
  665.       int nofree;
  666.  
  667.       lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
  668.                    converted_selection,
  669.                    &data, &type, &size, &format, &nofree);
  670.       
  671.       x_reply_selection_request (event, format, data, size, type);
  672.       successful_p = Qt;
  673.  
  674.       /* Indicate we have successfully processed this event.  */
  675.       x_selection_current_request = 0;
  676.  
  677.       if (!nofree)
  678.     xfree (data);
  679.     }
  680.   unbind_to (count, Qnil);
  681.  
  682.  DONE:
  683.  
  684.   UNGCPRO;
  685.  
  686.   /* Let random lisp code notice that the selection has been asked for.  */
  687.   {
  688.     Lisp_Object rest;
  689.     rest = Vx_sent_selection_hooks;
  690.     if (!EQ (rest, Qunbound))
  691.       for (; CONSP (rest); rest = Fcdr (rest))
  692.     call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
  693.   }
  694. }
  695.  
  696. /* Handle a SelectionClear event EVENT, which indicates that some other
  697.    client cleared out our previously asserted selection.
  698.    This is called from keyboard.c when such an event is found in the queue.  */
  699.  
  700. void
  701. x_handle_selection_clear (event)
  702.      struct input_event *event;
  703. {
  704.   Display *display = SELECTION_EVENT_DISPLAY (event);
  705.   Atom selection = SELECTION_EVENT_SELECTION (event);
  706.   Time changed_owner_time = SELECTION_EVENT_TIME (event);
  707.   
  708.   Lisp_Object selection_symbol, local_selection_data;
  709.   Time local_selection_time;
  710.  
  711.   selection_symbol = x_atom_to_symbol (display, selection);
  712.  
  713.   local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
  714.  
  715.   /* Well, we already believe that we don't own it, so that's just fine.  */
  716.   if (NILP (local_selection_data)) return;
  717.  
  718.   local_selection_time = (Time)
  719.     cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
  720.  
  721.   /* This SelectionClear is for a selection that we no longer own, so we can
  722.      disregard it.  (That is, we have reasserted the selection since this
  723.      request was generated.)  */
  724.  
  725.   if (changed_owner_time != CurrentTime
  726.       && local_selection_time > changed_owner_time)
  727.     return;
  728.  
  729.   /* Otherwise, we're really honest and truly being told to drop it.
  730.      Don't use Fdelq as that may QUIT;.  */
  731.  
  732.   if (EQ (local_selection_data, Fcar (Vselection_alist)))
  733.     Vselection_alist = Fcdr (Vselection_alist);
  734.   else
  735.     {
  736.       Lisp_Object rest;
  737.       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
  738.     if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
  739.       {
  740.         XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
  741.         break;
  742.       }
  743.     }
  744.  
  745.   /* Let random lisp code notice that the selection has been stolen.  */
  746.  
  747.   {
  748.     Lisp_Object rest;
  749.     rest = Vx_lost_selection_hooks;
  750.     if (!EQ (rest, Qunbound))
  751.       {
  752.     for (; CONSP (rest); rest = Fcdr (rest))
  753.       call1 (Fcar (rest), selection_symbol);
  754.     prepare_menu_bars ();
  755.     redisplay_preserve_echo_area ();
  756.       }
  757.   }
  758. }
  759.  
  760. /* Clear all selections that were made from frame F.
  761.    We do this when about to delete a frame.  */
  762.  
  763. void
  764. x_clear_frame_selections (f)
  765.      FRAME_PTR f;
  766. {
  767.   Lisp_Object frame;
  768.   Lisp_Object rest;
  769.  
  770.   XSET (frame, Lisp_Frame, f);
  771.  
  772.   /* Otherwise, we're really honest and truly being told to drop it.
  773.      Don't use Fdelq as that may QUIT;.  */
  774.  
  775.   while (!NILP (Vselection_alist)
  776.      && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
  777.     {
  778.       /* Let random Lisp code notice that the selection has been stolen.  */
  779.       Lisp_Object hooks, selection_symbol;
  780.  
  781.       hooks = Vx_lost_selection_hooks;
  782.       selection_symbol = Fcar (Vselection_alist);
  783.  
  784.       if (!EQ (hooks, Qunbound))
  785.     {
  786.       for (; CONSP (hooks); hooks = Fcdr (hooks))
  787.         call1 (Fcar (hooks), selection_symbol);
  788.       redisplay_preserve_echo_area ();
  789.     }
  790.  
  791.       Vselection_alist = Fcdr (Vselection_alist);
  792.     }
  793.  
  794.   for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
  795.     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
  796.       {
  797.     /* Let random Lisp code notice that the selection has been stolen.  */
  798.     Lisp_Object hooks, selection_symbol;
  799.  
  800.     hooks = Vx_lost_selection_hooks;
  801.     selection_symbol = Fcar (XCONS (rest)->cdr);
  802.  
  803.     if (!EQ (hooks, Qunbound))
  804.       {
  805.         for (; CONSP (hooks); hooks = Fcdr (hooks))
  806.           call1 (Fcar (hooks), selection_symbol);
  807.         redisplay_preserve_echo_area ();
  808.       }
  809.     XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
  810.     break;
  811.       }
  812. }
  813.  
  814. /* Nonzero if any properties for DISPLAY and WINDOW
  815.    are on the list of what we are waiting for.  */
  816.  
  817. static int
  818. waiting_for_other_props_on_window (display, window)
  819.      Display *display;
  820.      Window window;
  821. {
  822.   struct prop_location *rest = property_change_wait_list;
  823.   while (rest)
  824.     if (rest->display == display && rest->window == window)
  825.       return 1;
  826.     else
  827.       rest = rest->next;
  828.   return 0;
  829. }
  830.  
  831. /* Add an entry to the list of property changes we are waiting for.
  832.    DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
  833.    The return value is a number that uniquely identifies
  834.    this awaited property change.  */
  835.  
  836. static struct prop_location *
  837. expect_property_change (display, window, property, state)
  838.      Display *display;
  839.      Window window;
  840.      Lisp_Object property;
  841.      int state;
  842. {
  843.   struct prop_location *pl
  844.     = (struct prop_location *) xmalloc (sizeof (struct prop_location));
  845.   pl->identifier = ++prop_location_identifier;
  846.   pl->display = display;
  847.   pl->window = window;
  848.   pl->property = property;
  849.   pl->desired_state = state;
  850.   pl->next = property_change_wait_list;
  851.   pl->arrived = 0;
  852.   property_change_wait_list = pl;
  853.   return pl;
  854. }
  855.  
  856. /* Delete an entry from the list of property changes we are waiting for.
  857.    IDENTIFIER is the number that uniquely identifies the entry.  */
  858.  
  859. static void
  860. unexpect_property_change (location)
  861.      struct prop_location *location;
  862. {
  863.   struct prop_location *prev = 0, *rest = property_change_wait_list;
  864.   while (rest)
  865.     {
  866.       if (rest == location)
  867.     {
  868.       if (prev)
  869.         prev->next = rest->next;
  870.       else
  871.         property_change_wait_list = rest->next;
  872.       xfree (rest);
  873.       return;
  874.     }
  875.       prev = rest;
  876.       rest = rest->next;
  877.     }
  878. }
  879.  
  880. /* Remove the property change expectation element for IDENTIFIER.  */
  881.  
  882. static Lisp_Object
  883. wait_for_property_change_unwind (identifierval)
  884.      Lisp_Object identifierval;
  885. {
  886.   unexpect_property_change (XPNTR (identifierval));
  887. }
  888.  
  889. /* Actually wait for a property change.
  890.    IDENTIFIER should be the value that expect_property_change returned.  */
  891.  
  892. static void
  893. wait_for_property_change (location)
  894.      struct prop_location *location;
  895. {
  896.   int secs, usecs;
  897.   int count = specpdl_ptr - specpdl;
  898.   Lisp_Object tem;
  899.  
  900.   XSET (tem, Lisp_Cons, location);
  901.  
  902.   /* Make sure to do unexpect_property_change if we quit or err.  */
  903.   record_unwind_protect (wait_for_property_change_unwind, tem);
  904.  
  905.   XCONS (property_change_reply)->car = Qnil;
  906.  
  907.   if (! location->arrived)
  908.     {
  909.       property_change_reply_object = location;
  910.       secs = x_selection_timeout / 1000;
  911.       usecs = (x_selection_timeout % 1000) * 1000;
  912.       wait_reading_process_input (secs, usecs, property_change_reply, 0);
  913.  
  914.       if (NILP (XCONS (property_change_reply)->car))
  915.     error ("timed out waiting for property-notify event");
  916.     }
  917.  
  918.   unbind_to (count, Qnil);
  919. }
  920.  
  921. /* Called from XTread_socket in response to a PropertyNotify event.  */
  922.  
  923. void
  924. x_handle_property_notify (event)
  925.      XPropertyEvent *event;
  926. {
  927.   struct prop_location *prev = 0, *rest = property_change_wait_list;
  928.   while (rest)
  929.     {
  930.       if (rest->property == event->atom
  931.       && rest->window == event->window
  932.       && rest->display == event->display
  933.       && rest->desired_state == event->state)
  934.     {
  935. #if 0
  936.       fprintf (stderr, "Saw expected prop-%s on %s\n",
  937.            (event->state == PropertyDelete ? "delete" : "change"),
  938.            (char *) XSYMBOL (x_atom_to_symbol (event->display,
  939.                                event->atom))
  940.            ->name->data);
  941. #endif
  942.  
  943.       rest->arrived = 1;
  944.  
  945.       /* If this is the one wait_for_property_change is waiting for,
  946.          tell it to wake up.  */
  947.       if (rest == property_change_reply_object)
  948.         XCONS (property_change_reply)->car = Qt;
  949.  
  950.       if (prev)
  951.         prev->next = rest->next;
  952.       else
  953.         property_change_wait_list = rest->next;
  954.       xfree (rest);
  955.       return;
  956.     }
  957.       prev = rest;
  958.       rest = rest->next;
  959.     }
  960. #if 0
  961.   fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
  962.        (event->state == PropertyDelete ? "delete" : "change"),
  963.        (char *) XSYMBOL (x_atom_to_symbol (event->display, event->atom))
  964.        ->name->data);
  965. #endif
  966. }
  967.  
  968.  
  969.  
  970. #if 0 /* #### MULTIPLE doesn't work yet */
  971.  
  972. static Lisp_Object
  973. fetch_multiple_target (event)
  974.      XSelectionRequestEvent *event;
  975. {
  976.   Display *display = event->display;
  977.   Window window = event->requestor;
  978.   Atom target = event->target;
  979.   Atom selection_atom = event->selection;
  980.   int result;
  981.  
  982.   return
  983.     Fcons (QMULTIPLE,
  984.        x_get_window_property_as_lisp_data (display, window, target,
  985.                            QMULTIPLE, selection_atom));
  986. }
  987.  
  988. static Lisp_Object
  989. copy_multiple_data (obj)
  990.      Lisp_Object obj;
  991. {
  992.   Lisp_Object vec;
  993.   int i;
  994.   int size;
  995.   if (CONSP (obj))
  996.     return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
  997.     
  998.   CHECK_VECTOR (obj, 0);
  999.   vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
  1000.   for (i = 0; i < size; i++)
  1001.     {
  1002.       Lisp_Object vec2 = XVECTOR (obj)->contents [i];
  1003.       CHECK_VECTOR (vec2, 0);
  1004.       if (XVECTOR (vec2)->size != 2)
  1005.     /* ??? Confusing error message */
  1006.     Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
  1007.                 Fcons (vec2, Qnil)));
  1008.       XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
  1009.       XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
  1010.     = XVECTOR (vec2)->contents [0];
  1011.       XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
  1012.     = XVECTOR (vec2)->contents [1];
  1013.     }
  1014.   return vec;
  1015. }
  1016.  
  1017. #endif
  1018.  
  1019.  
  1020. /* Variables for communication with x_handle_selection_notify.  */
  1021. static Atom reading_which_selection;
  1022. static Lisp_Object reading_selection_reply;
  1023. static Window reading_selection_window;
  1024.  
  1025. /* Do protocol to read selection-data from the server.
  1026.    Converts this to Lisp data and returns it.  */
  1027.  
  1028. static Lisp_Object
  1029. x_get_foreign_selection (selection_symbol, target_type)
  1030.      Lisp_Object selection_symbol, target_type;
  1031. {
  1032.   Display *display = x_current_display;
  1033.   Window requestor_window = FRAME_X_WINDOW (selected_frame);
  1034.   Time requestor_time = last_event_timestamp;
  1035.   Atom target_property = Xatom_EMACS_TMP;
  1036.   Atom selection_atom = symbol_to_x_atom (display, selection_symbol);
  1037.   Atom type_atom;
  1038.   int secs, usecs;
  1039.  
  1040.   if (CONSP (target_type))
  1041.     type_atom = symbol_to_x_atom (display, XCONS (target_type)->car);
  1042.   else
  1043.     type_atom = symbol_to_x_atom (display, target_type);
  1044.  
  1045.   BLOCK_INPUT;
  1046.   x_catch_errors ();
  1047.   XConvertSelection (display, selection_atom, type_atom, target_property,
  1048.              requestor_window, requestor_time);
  1049.   XFlushQueue ();
  1050.  
  1051.   /* Prepare to block until the reply has been read.  */
  1052.   reading_selection_window = requestor_window;
  1053.   reading_which_selection = selection_atom;
  1054.   XCONS (reading_selection_reply)->car = Qnil;
  1055.   x_start_queuing_selection_requests ();
  1056.   UNBLOCK_INPUT;
  1057.  
  1058.   /* This allows quits.  Also, don't wait forever.  */
  1059.   secs = x_selection_timeout / 1000;
  1060.   usecs = (x_selection_timeout % 1000) * 1000;
  1061.   wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
  1062.  
  1063.   BLOCK_INPUT;
  1064.   x_check_errors ("Cannot get selection: %s");
  1065.   x_uncatch_errors ();
  1066.   x_stop_queuing_selection_requests ();
  1067.   UNBLOCK_INPUT;
  1068.  
  1069.   if (NILP (XCONS (reading_selection_reply)->car))
  1070.     error ("timed out waiting for reply from selection owner");
  1071.  
  1072.   /* Otherwise, the selection is waiting for us on the requested property.  */
  1073.   return
  1074.     x_get_window_property_as_lisp_data (display, requestor_window,
  1075.                     target_property, target_type,
  1076.                     selection_atom);
  1077. }
  1078.  
  1079. /* Subroutines of x_get_window_property_as_lisp_data */
  1080.  
  1081. static void
  1082. x_get_window_property (display, window, property, data_ret, bytes_ret,
  1083.                actual_type_ret, actual_format_ret, actual_size_ret,
  1084.                delete_p)
  1085.      Display *display;
  1086.      Window window;
  1087.      Atom property;
  1088.      unsigned char **data_ret;
  1089.      int *bytes_ret;
  1090.      Atom *actual_type_ret;
  1091.      int *actual_format_ret;
  1092.      unsigned long *actual_size_ret;
  1093.      int delete_p;
  1094. {
  1095.   int total_size;
  1096.   unsigned long bytes_remaining;
  1097.   int offset = 0;
  1098.   unsigned char *tmp_data = 0;
  1099.   int result;
  1100.   int buffer_size = SELECTION_QUANTUM (display);
  1101.   if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
  1102.   
  1103.   BLOCK_INPUT;
  1104.   /* First probe the thing to find out how big it is.  */
  1105.   result = XGetWindowProperty (display, window, property,
  1106.                    0, 0, False, AnyPropertyType,
  1107.                    actual_type_ret, actual_format_ret,
  1108.                    actual_size_ret,
  1109.                    &bytes_remaining, &tmp_data);
  1110.   if (result != Success)
  1111.     {
  1112.       UNBLOCK_INPUT;
  1113.       *data_ret = 0;
  1114.       *bytes_ret = 0;
  1115.       return;
  1116.     }
  1117.   xfree ((char *) tmp_data);
  1118.   
  1119.   if (*actual_type_ret == None || *actual_format_ret == 0)
  1120.     {
  1121.       UNBLOCK_INPUT;
  1122.       return;
  1123.     }
  1124.  
  1125.   total_size = bytes_remaining + 1;
  1126.   *data_ret = (unsigned char *) xmalloc (total_size);
  1127.   
  1128.   /* Now read, until weve gotten it all.  */
  1129.   while (bytes_remaining)
  1130.     {
  1131. #if 0
  1132.       int last = bytes_remaining;
  1133. #endif
  1134.       result
  1135.     = XGetWindowProperty (display, window, property,
  1136.                   offset/4, buffer_size/4,
  1137.                   False,
  1138.                   AnyPropertyType,
  1139.                   actual_type_ret, actual_format_ret,
  1140.                   actual_size_ret, &bytes_remaining, &tmp_data);
  1141. #if 0
  1142.       fprintf (stderr, "<< read %d\n", last-bytes_remaining);
  1143. #endif
  1144.       /* If this doesn't return Success at this point, it means that
  1145.      some clod deleted the selection while we were in the midst of
  1146.      reading it.  Deal with that, I guess....
  1147.        */
  1148.       if (result != Success) break;
  1149.       *actual_size_ret *= *actual_format_ret / 8;
  1150.       bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
  1151.       offset += *actual_size_ret;
  1152.       xfree ((char *) tmp_data);
  1153.     }
  1154.  
  1155.   XFlushQueue ();
  1156.   UNBLOCK_INPUT;
  1157.   *bytes_ret = offset;
  1158. }
  1159.  
  1160. static void
  1161. receive_incremental_selection (display, window, property, target_type,
  1162.                    min_size_bytes, data_ret, size_bytes_ret,
  1163.                    type_ret, format_ret, size_ret)
  1164.      Display *display;
  1165.      Window window;
  1166.      Atom property;
  1167.      Lisp_Object target_type; /* for error messages only */
  1168.      unsigned int min_size_bytes;
  1169.      unsigned char **data_ret;
  1170.      int *size_bytes_ret;
  1171.      Atom *type_ret;
  1172.      unsigned long *size_ret;
  1173.      int *format_ret;
  1174. {
  1175.   int offset = 0;
  1176.   struct prop_location *wait_object;
  1177.   *size_bytes_ret = min_size_bytes;
  1178.   *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
  1179. #if 0
  1180.   fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
  1181. #endif
  1182.  
  1183.   /* At this point, we have read an INCR property.
  1184.      Delete the property to ack it.
  1185.      (But first, prepare to receive the next event in this handshake.)
  1186.  
  1187.      Now, we must loop, waiting for the sending window to put a value on
  1188.      that property, then reading the property, then deleting it to ack.
  1189.      We are done when the sender places a property of length 0.
  1190.    */
  1191.   BLOCK_INPUT;
  1192.   XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
  1193.   XDeleteProperty (display, window, property);
  1194.   wait_object = expect_property_change (display, window, property,
  1195.                     PropertyNewValue);
  1196.   XFlushQueue ();
  1197.   UNBLOCK_INPUT;
  1198.  
  1199.   while (1)
  1200.     {
  1201.       unsigned char *tmp_data;
  1202.       int tmp_size_bytes;
  1203.       wait_for_property_change (wait_object);
  1204.       /* expect it again immediately, because x_get_window_property may
  1205.      .. no it wont, I dont get it.
  1206.      .. Ok, I get it now, the Xt code that implements INCR is broken.
  1207.        */
  1208.       x_get_window_property (display, window, property,
  1209.                  &tmp_data, &tmp_size_bytes,
  1210.                  type_ret, format_ret, size_ret, 1);
  1211.  
  1212.       if (tmp_size_bytes == 0) /* we're done */
  1213.     {
  1214. #if 0
  1215.       fprintf (stderr, "  read INCR done\n");
  1216. #endif
  1217.       if (! waiting_for_other_props_on_window (display, window))
  1218.         XSelectInput (display, window, STANDARD_EVENT_SET);
  1219.       unexpect_property_change (wait_object);
  1220.       if (tmp_data) xfree (tmp_data);
  1221.       break;
  1222.     }
  1223.  
  1224.       BLOCK_INPUT;
  1225.       XDeleteProperty (display, window, property);
  1226.       wait_object = expect_property_change (display, window, property,
  1227.                         PropertyNewValue);
  1228.       XFlushQueue ();
  1229.       UNBLOCK_INPUT;
  1230.  
  1231. #if 0
  1232.       fprintf (stderr, "  read INCR %d\n", tmp_size_bytes);
  1233. #endif
  1234.       if (*size_bytes_ret < offset + tmp_size_bytes)
  1235.     {
  1236. #if 0
  1237.       fprintf (stderr, "  read INCR realloc %d -> %d\n",
  1238.            *size_bytes_ret, offset + tmp_size_bytes);
  1239. #endif
  1240.       *size_bytes_ret = offset + tmp_size_bytes;
  1241.       *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
  1242.     }
  1243.       bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
  1244.       offset += tmp_size_bytes;
  1245.       xfree (tmp_data);
  1246.     }
  1247. }
  1248.  
  1249. /* Once a requested selection is "ready" (we got a SelectionNotify event),
  1250.    fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
  1251.    TARGET_TYPE and SELECTION_ATOM are used in error message if this fails.  */
  1252.  
  1253. static Lisp_Object
  1254. x_get_window_property_as_lisp_data (display, window, property, target_type,
  1255.                     selection_atom)
  1256.      Display *display;
  1257.      Window window;
  1258.      Atom property;
  1259.      Lisp_Object target_type;    /* for error messages only */
  1260.      Atom selection_atom;    /* for error messages only */
  1261. {
  1262.   Atom actual_type;
  1263.   int actual_format;
  1264.   unsigned long actual_size;
  1265.   unsigned char *data = 0;
  1266.   int bytes = 0;
  1267.   Lisp_Object val;
  1268.  
  1269.   x_get_window_property (display, window, property, &data, &bytes,
  1270.              &actual_type, &actual_format, &actual_size, 1);
  1271.   if (! data)
  1272.     {
  1273.       int there_is_a_selection_owner;
  1274.       BLOCK_INPUT;
  1275.       there_is_a_selection_owner
  1276.     = XGetSelectionOwner (display, selection_atom);
  1277.       UNBLOCK_INPUT;
  1278.       while (1) /* Note debugger can no longer return, so this is obsolete */
  1279.     Fsignal (Qerror,
  1280.          there_is_a_selection_owner ?
  1281.          Fcons (build_string ("selection owner couldn't convert"),
  1282.             actual_type
  1283.             ? Fcons (target_type,
  1284.                  Fcons (x_atom_to_symbol (display, actual_type),
  1285.                     Qnil))
  1286.             : Fcons (target_type, Qnil))
  1287.          : Fcons (build_string ("no selection"),
  1288.               Fcons (x_atom_to_symbol (display, selection_atom),
  1289.                  Qnil)));
  1290.     }
  1291.   
  1292.   if (actual_type == Xatom_INCR)
  1293.     {
  1294.       /* That wasn't really the data, just the beginning.  */
  1295.  
  1296.       unsigned int min_size_bytes = * ((unsigned int *) data);
  1297.       BLOCK_INPUT;
  1298.       XFree ((char *) data);
  1299.       UNBLOCK_INPUT;
  1300.       receive_incremental_selection (display, window, property, target_type,
  1301.                      min_size_bytes, &data, &bytes,
  1302.                      &actual_type, &actual_format,
  1303.                      &actual_size);
  1304.     }
  1305.  
  1306.   BLOCK_INPUT;
  1307.   XDeleteProperty (display, window, property);
  1308.   XFlushQueue ();
  1309.   UNBLOCK_INPUT;
  1310.  
  1311.   /* It's been read.  Now convert it to a lisp object in some semi-rational
  1312.      manner.  */
  1313.   val = selection_data_to_lisp_data (display, data, bytes,
  1314.                      actual_type, actual_format);
  1315.   
  1316.   xfree ((char *) data);
  1317.   return val;
  1318. }
  1319.  
  1320. /* These functions convert from the selection data read from the server into
  1321.    something that we can use from Lisp, and vice versa.
  1322.  
  1323.     Type:    Format:    Size:        Lisp Type:
  1324.     -----    -------    -----        -----------
  1325.     *    8    *        String
  1326.     ATOM    32    1        Symbol
  1327.     ATOM    32    > 1        Vector of Symbols
  1328.     *    16    1        Integer
  1329.     *    16    > 1        Vector of Integers
  1330.     *    32    1        if <=16 bits: Integer
  1331.                     if > 16 bits: Cons of top16, bot16
  1332.     *    32    > 1        Vector of the above
  1333.  
  1334.    When converting a Lisp number to C, it is assumed to be of format 16 if
  1335.    it is an integer, and of format 32 if it is a cons of two integers.
  1336.  
  1337.    When converting a vector of numbers from Lisp to C, it is assumed to be
  1338.    of format 16 if every element in the vector is an integer, and is assumed
  1339.    to be of format 32 if any element is a cons of two integers.
  1340.  
  1341.    When converting an object to C, it may be of the form (SYMBOL . <data>)
  1342.    where SYMBOL is what we should claim that the type is.  Format and
  1343.    representation are as above.  */
  1344.  
  1345.  
  1346.  
  1347. static Lisp_Object
  1348. selection_data_to_lisp_data (display, data, size, type, format)
  1349.      Display *display;
  1350.      unsigned char *data;
  1351.      Atom type;
  1352.      int size, format;
  1353. {
  1354.  
  1355.   if (type == Xatom_NULL)
  1356.     return QNULL;
  1357.  
  1358.   /* Convert any 8-bit data to a string, for compactness.  */
  1359.   else if (format == 8)
  1360.     return make_string ((char *) data, size);
  1361.  
  1362.   /* Convert a single atom to a Lisp_Symbol.  Convert a set of atoms to
  1363.      a vector of symbols.
  1364.    */
  1365.   else if (type == XA_ATOM)
  1366.     {
  1367.       int i;
  1368.       if (size == sizeof (Atom))
  1369.     return x_atom_to_symbol (display, *((Atom *) data));
  1370.       else
  1371.     {
  1372.       Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
  1373.       for (i = 0; i < size / sizeof (Atom); i++)
  1374.         Faset (v, i, x_atom_to_symbol (display, ((Atom *) data) [i]));
  1375.       return v;
  1376.     }
  1377.     }
  1378.  
  1379.   /* Convert a single 16 or small 32 bit number to a Lisp_Int.
  1380.      If the number is > 16 bits, convert it to a cons of integers,
  1381.      16 bits in each half.
  1382.    */
  1383.   else if (format == 32 && size == sizeof (long))
  1384.     return long_to_cons (((unsigned long *) data) [0]);
  1385.   else if (format == 16 && size == sizeof (short))
  1386.     return make_number ((int) (((unsigned short *) data) [0]));
  1387.  
  1388.   /* Convert any other kind of data to a vector of numbers, represented
  1389.      as above (as an integer, or a cons of two 16 bit integers.)
  1390.    */
  1391.   else if (format == 16)
  1392.     {
  1393.       int i;
  1394.       Lisp_Object v = Fmake_vector (size / 4, 0);
  1395.       for (i = 0; i < size / 4; i++)
  1396.     {
  1397.       int j = (int) ((unsigned short *) data) [i];
  1398.       Faset (v, i, make_number (j));
  1399.     }
  1400.       return v;
  1401.     }
  1402.   else
  1403.     {
  1404.       int i;
  1405.       Lisp_Object v = Fmake_vector (size / 4, 0);
  1406.       for (i = 0; i < size / 4; i++)
  1407.     {
  1408.       unsigned long j = ((unsigned long *) data) [i];
  1409.       Faset (v, i, long_to_cons (j));
  1410.     }
  1411.       return v;
  1412.     }
  1413. }
  1414.  
  1415.  
  1416. static void
  1417. lisp_data_to_selection_data (display, obj,
  1418.                  data_ret, type_ret, size_ret,
  1419.                  format_ret, nofree_ret)
  1420.      Display *display;
  1421.      Lisp_Object obj;
  1422.      unsigned char **data_ret;
  1423.      Atom *type_ret;
  1424.      unsigned int *size_ret;
  1425.      int *format_ret;
  1426.      int *nofree_ret;
  1427. {
  1428.   Lisp_Object type = Qnil;
  1429.  
  1430.   *nofree_ret = 0;
  1431.  
  1432.   if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
  1433.     {
  1434.       type = XCONS (obj)->car;
  1435.       obj = XCONS (obj)->cdr;
  1436.       if (CONSP (obj) && NILP (XCONS (obj)->cdr))
  1437.     obj = XCONS (obj)->car;
  1438.     }
  1439.  
  1440.   if (EQ (obj, QNULL) || (EQ (type, QNULL)))
  1441.     {                /* This is not the same as declining */
  1442.       *format_ret = 32;
  1443.       *size_ret = 0;
  1444.       *data_ret = 0;
  1445.       type = QNULL;
  1446.     }
  1447.   else if (STRINGP (obj))
  1448.     {
  1449.       *format_ret = 8;
  1450.       *size_ret = XSTRING (obj)->size;
  1451.       *data_ret = XSTRING (obj)->data;
  1452.       *nofree_ret = 1;
  1453.       if (NILP (type)) type = QSTRING;
  1454.     }
  1455.   else if (SYMBOLP (obj))
  1456.     {
  1457.       *format_ret = 32;
  1458.       *size_ret = 1;
  1459.       *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
  1460.       (*data_ret) [sizeof (Atom)] = 0;
  1461.       (*(Atom **) data_ret) [0] = symbol_to_x_atom (display, obj);
  1462.       if (NILP (type)) type = QATOM;
  1463.     }
  1464.   else if (INTEGERP (obj)
  1465.        && XINT (obj) < 0xFFFF
  1466.        && XINT (obj) > -0xFFFF)
  1467.     {
  1468.       *format_ret = 16;
  1469.       *size_ret = 1;
  1470.       *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
  1471.       (*data_ret) [sizeof (short)] = 0;
  1472.       (*(short **) data_ret) [0] = (short) XINT (obj);
  1473.       if (NILP (type)) type = QINTEGER;
  1474.     }
  1475.   else if (INTEGERP (obj)
  1476.        || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
  1477.            && (INTEGERP (XCONS (obj)->cdr)
  1478.            || (CONSP (XCONS (obj)->cdr)
  1479.                && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
  1480.     {
  1481.       *format_ret = 32;
  1482.       *size_ret = 1;
  1483.       *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
  1484.       (*data_ret) [sizeof (long)] = 0;
  1485.       (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
  1486.       if (NILP (type)) type = QINTEGER;
  1487.     }
  1488.   else if (VECTORP (obj))
  1489.     {
  1490.       /* Lisp_Vectors may represent a set of ATOMs;
  1491.      a set of 16 or 32 bit INTEGERs;
  1492.      or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
  1493.        */
  1494.       int i;
  1495.  
  1496.       if (SYMBOLP (XVECTOR (obj)->contents [0]))
  1497.     /* This vector is an ATOM set */
  1498.     {
  1499.       if (NILP (type)) type = QATOM;
  1500.       *size_ret = XVECTOR (obj)->size;
  1501.       *format_ret = 32;
  1502.       *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
  1503.       for (i = 0; i < *size_ret; i++)
  1504.         if (SYMBOLP (XVECTOR (obj)->contents [i]))
  1505.           (*(Atom **) data_ret) [i]
  1506.         = symbol_to_x_atom (display, XVECTOR (obj)->contents [i]);
  1507.         else
  1508.           Fsignal (Qerror, /* Qselection_error */
  1509.                Fcons (build_string
  1510.            ("all elements of selection vector must have same type"),
  1511.                   Fcons (obj, Qnil)));
  1512.     }
  1513. #if 0 /* #### MULTIPLE doesn't work yet */
  1514.       else if (VECTORP (XVECTOR (obj)->contents [0]))
  1515.     /* This vector is an ATOM_PAIR set */
  1516.     {
  1517.       if (NILP (type)) type = QATOM_PAIR;
  1518.       *size_ret = XVECTOR (obj)->size;
  1519.       *format_ret = 32;
  1520.       *data_ret = (unsigned char *)
  1521.         xmalloc ((*size_ret) * sizeof (Atom) * 2);
  1522.       for (i = 0; i < *size_ret; i++)
  1523.         if (VECTORP (XVECTOR (obj)->contents [i]))
  1524.           {
  1525.         Lisp_Object pair = XVECTOR (obj)->contents [i];
  1526.         if (XVECTOR (pair)->size != 2)
  1527.           Fsignal (Qerror,
  1528.                Fcons (build_string 
  1529.        ("elements of the vector must be vectors of exactly two elements"),
  1530.                   Fcons (pair, Qnil)));
  1531.         
  1532.         (*(Atom **) data_ret) [i * 2]
  1533.           = symbol_to_x_atom (display, XVECTOR (pair)->contents [0]);
  1534.         (*(Atom **) data_ret) [(i * 2) + 1]
  1535.           = symbol_to_x_atom (display, XVECTOR (pair)->contents [1]);
  1536.           }
  1537.         else
  1538.           Fsignal (Qerror,
  1539.                Fcons (build_string
  1540.            ("all elements of the vector must be of the same type"),
  1541.                   Fcons (obj, Qnil)));
  1542.       
  1543.     }
  1544. #endif
  1545.       else
  1546.     /* This vector is an INTEGER set, or something like it */
  1547.     {
  1548.       *size_ret = XVECTOR (obj)->size;
  1549.       if (NILP (type)) type = QINTEGER;
  1550.       *format_ret = 16;
  1551.       for (i = 0; i < *size_ret; i++)
  1552.         if (CONSP (XVECTOR (obj)->contents [i]))
  1553.           *format_ret = 32;
  1554.         else if (!INTEGERP (XVECTOR (obj)->contents [i]))
  1555.           Fsignal (Qerror, /* Qselection_error */
  1556.                Fcons (build_string
  1557.     ("elements of selection vector must be integers or conses of integers"),
  1558.                   Fcons (obj, Qnil)));
  1559.  
  1560.       *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
  1561.       for (i = 0; i < *size_ret; i++)
  1562.         if (*format_ret == 32)
  1563.           (*((unsigned long **) data_ret)) [i]
  1564.         = cons_to_long (XVECTOR (obj)->contents [i]);
  1565.         else
  1566.           (*((unsigned short **) data_ret)) [i]
  1567.         = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
  1568.     }
  1569.     }
  1570.   else
  1571.     Fsignal (Qerror, /* Qselection_error */
  1572.          Fcons (build_string ("unrecognised selection data"),
  1573.             Fcons (obj, Qnil)));
  1574.  
  1575.   *type_ret = symbol_to_x_atom (display, type);
  1576. }
  1577.  
  1578. static Lisp_Object
  1579. clean_local_selection_data (obj)
  1580.      Lisp_Object obj;
  1581. {
  1582.   if (CONSP (obj)
  1583.       && INTEGERP (XCONS (obj)->car)
  1584.       && CONSP (XCONS (obj)->cdr)
  1585.       && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
  1586.       && NILP (XCONS (XCONS (obj)->cdr)->cdr))
  1587.     obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
  1588.  
  1589.   if (CONSP (obj)
  1590.       && INTEGERP (XCONS (obj)->car)
  1591.       && INTEGERP (XCONS (obj)->cdr))
  1592.     {
  1593.       if (XINT (XCONS (obj)->car) == 0)
  1594.     return XCONS (obj)->cdr;
  1595.       if (XINT (XCONS (obj)->car) == -1)
  1596.     return make_number (- XINT (XCONS (obj)->cdr));
  1597.     }
  1598.   if (VECTORP (obj))
  1599.     {
  1600.       int i;
  1601.       int size = XVECTOR (obj)->size;
  1602.       Lisp_Object copy;
  1603.       if (size == 1)
  1604.     return clean_local_selection_data (XVECTOR (obj)->contents [0]);
  1605.       copy = Fmake_vector (size, Qnil);
  1606.       for (i = 0; i < size; i++)
  1607.     XVECTOR (copy)->contents [i]
  1608.       = clean_local_selection_data (XVECTOR (obj)->contents [i]);
  1609.       return copy;
  1610.     }
  1611.   return obj;
  1612. }
  1613.  
  1614. /* Called from XTread_socket to handle SelectionNotify events.
  1615.    If it's the selection we are waiting for, stop waiting.  */
  1616.  
  1617. void
  1618. x_handle_selection_notify (event)
  1619.      XSelectionEvent *event;
  1620. {
  1621.   if (event->requestor != reading_selection_window)
  1622.     return;
  1623.   if (event->selection != reading_which_selection)
  1624.     return;
  1625.  
  1626.   XCONS (reading_selection_reply)->car = Qt;
  1627. }
  1628.  
  1629.  
  1630. DEFUN ("x-own-selection-internal",
  1631.        Fx_own_selection_internal, Sx_own_selection_internal,
  1632.   2, 2, 0,
  1633.   "Assert an X selection of the given TYPE with the given VALUE.\n\
  1634. TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
  1635. \(Those are literal upper-case symbol names, since that's what X expects.)\n\
  1636. VALUE is typically a string, or a cons of two markers, but may be\n\
  1637. anything that the functions on `selection-converter-alist' know about.")
  1638.   (selection_name, selection_value)
  1639.      Lisp_Object selection_name, selection_value;
  1640. {
  1641.   check_x ();
  1642.   CHECK_SYMBOL (selection_name, 0);
  1643.   if (NILP (selection_value)) error ("selection-value may not be nil.");
  1644.   x_own_selection (selection_name, selection_value);
  1645.   return selection_value;
  1646. }
  1647.  
  1648.  
  1649. /* Request the selection value from the owner.  If we are the owner,
  1650.    simply return our selection value.  If we are not the owner, this
  1651.    will block until all of the data has arrived.  */
  1652.  
  1653. DEFUN ("x-get-selection-internal",
  1654.   Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
  1655.   "Return text selected from some X window.\n\
  1656. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
  1657. \(Those are literal upper-case symbol names, since that's what X expects.)\n\
  1658. TYPE is the type of data desired, typically `STRING'.")
  1659.   (selection_symbol, target_type)
  1660.      Lisp_Object selection_symbol, target_type;
  1661. {
  1662.   Lisp_Object val = Qnil;
  1663.   struct gcpro gcpro1, gcpro2;
  1664.   GCPRO2 (target_type, val); /* we store newly consed data into these */
  1665.   check_x ();
  1666.   CHECK_SYMBOL (selection_symbol, 0);
  1667.  
  1668. #if 0 /* #### MULTIPLE doesn't work yet */
  1669.   if (CONSP (target_type)
  1670.       && XCONS (target_type)->car == QMULTIPLE)
  1671.     {
  1672.       CHECK_VECTOR (XCONS (target_type)->cdr, 0);
  1673.       /* So we don't destructively modify this...  */
  1674.       target_type = copy_multiple_data (target_type);
  1675.     }
  1676.   else
  1677. #endif
  1678.     CHECK_SYMBOL (target_type, 0);
  1679.  
  1680.   val = x_get_local_selection (selection_symbol, target_type);
  1681.  
  1682.   if (NILP (val))
  1683.     {
  1684.       val = x_get_foreign_selection (selection_symbol, target_type);
  1685.       goto DONE;
  1686.     }
  1687.  
  1688.   if (CONSP (val)
  1689.       && SYMBOLP (XCONS (val)->car))
  1690.     {
  1691.       val = XCONS (val)->cdr;
  1692.       if (CONSP (val) && NILP (XCONS (val)->cdr))
  1693.     val = XCONS (val)->car;
  1694.     }
  1695.   val = clean_local_selection_data (val);
  1696.  DONE:
  1697.   UNGCPRO;
  1698.   return val;
  1699. }
  1700.  
  1701. DEFUN ("x-disown-selection-internal",
  1702.   Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
  1703.   "If we own the selection SELECTION, disown it.\n\
  1704. Disowning it means there is no such selection.")
  1705.   (selection, time)
  1706.      Lisp_Object selection;
  1707.      Lisp_Object time;
  1708. {
  1709.   Display *display = x_current_display;
  1710.   Time timestamp;
  1711.   Atom selection_atom;
  1712.   XSelectionClearEvent event;
  1713.  
  1714.   check_x ();
  1715.   CHECK_SYMBOL (selection, 0);
  1716.   if (NILP (time))
  1717.     timestamp = last_event_timestamp;
  1718.   else
  1719.     timestamp = cons_to_long (time);
  1720.  
  1721.   if (NILP (assq_no_quit (selection, Vselection_alist)))
  1722.     return Qnil;  /* Don't disown the selection when we're not the owner.  */
  1723.  
  1724.   selection_atom = symbol_to_x_atom (display, selection);
  1725.  
  1726.   BLOCK_INPUT;
  1727.   XSetSelectionOwner (display, selection_atom, None, timestamp);
  1728.   UNBLOCK_INPUT;
  1729.  
  1730.   /* It doesn't seem to be guaranteed that a SelectionClear event will be
  1731.      generated for a window which owns the selection when that window sets
  1732.      the selection owner to None.  The NCD server does, the MIT Sun4 server
  1733.      doesn't.  So we synthesize one; this means we might get two, but
  1734.      that's ok, because the second one won't have any effect.  */
  1735.   SELECTION_EVENT_DISPLAY (&event) = display;
  1736.   SELECTION_EVENT_SELECTION (&event) = selection_atom;
  1737.   SELECTION_EVENT_TIME (&event) = timestamp;
  1738.   x_handle_selection_clear (&event);
  1739.  
  1740.   return Qt;
  1741. }
  1742.  
  1743. /* Get rid of all the selections in buffer BUFFER.
  1744.    This is used when we kill a buffer.  */
  1745.  
  1746. void
  1747. x_disown_buffer_selections (buffer)
  1748.      Lisp_Object buffer;
  1749. {
  1750.   Lisp_Object tail;
  1751.   struct buffer *buf = XBUFFER (buffer);
  1752.  
  1753.   for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
  1754.     {
  1755.       Lisp_Object elt, value;
  1756.       elt = XCONS (tail)->car;
  1757.       value = XCONS (elt)->cdr;
  1758.       if (CONSP (value) && MARKERP (XCONS (value)->car)
  1759.       && XMARKER (XCONS (value)->car)->buffer == buf)
  1760.     Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
  1761.     }
  1762. }
  1763.  
  1764. DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
  1765.   0, 1, 0,
  1766.   "Whether the current Emacs process owns the given X Selection.\n\
  1767. The arg should be the name of the selection in question, typically one of\n\
  1768. the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
  1769. \(Those are literal upper-case symbol names, since that's what X expects.)\n\
  1770. For convenience, the symbol nil is the same as `PRIMARY',\n\
  1771. and t is the same as `SECONDARY'.)")
  1772.   (selection)
  1773.      Lisp_Object selection;
  1774. {
  1775.   check_x ();
  1776.   CHECK_SYMBOL (selection, 0);
  1777.   if (EQ (selection, Qnil)) selection = QPRIMARY;
  1778.   if (EQ (selection, Qt)) selection = QSECONDARY;
  1779.   
  1780.   if (NILP (Fassq (selection, Vselection_alist)))
  1781.     return Qnil;
  1782.   return Qt;
  1783. }
  1784.  
  1785. DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
  1786.   0, 1, 0,
  1787.   "Whether there is an owner for the given X Selection.\n\
  1788. The arg should be the name of the selection in question, typically one of\n\
  1789. the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
  1790. \(Those are literal upper-case symbol names, since that's what X expects.)\n\
  1791. For convenience, the symbol nil is the same as `PRIMARY',\n\
  1792. and t is the same as `SECONDARY'.)")
  1793.   (selection)
  1794.      Lisp_Object selection;
  1795. {
  1796.   Window owner;
  1797.   Atom atom;
  1798.   Display *dpy = x_current_display;
  1799.   check_x ();
  1800.   CHECK_SYMBOL (selection, 0);
  1801.   if (!NILP (Fx_selection_owner_p (selection)))
  1802.     return Qt;
  1803.   if (EQ (selection, Qnil)) selection = QPRIMARY;
  1804.   if (EQ (selection, Qt)) selection = QSECONDARY;
  1805.   atom = symbol_to_x_atom (dpy, selection);
  1806.   if (atom == 0)
  1807.     return Qnil;
  1808.   BLOCK_INPUT;
  1809.   owner = XGetSelectionOwner (dpy, atom);
  1810.   UNBLOCK_INPUT;
  1811.   return (owner ? Qt : Qnil);
  1812. }
  1813.  
  1814.  
  1815. #ifdef CUT_BUFFER_SUPPORT
  1816.  
  1817. static int cut_buffers_initialized; /* Whether we're sure they all exist */
  1818.  
  1819. /* Ensure that all 8 cut buffers exist.  ICCCM says we gotta...  */
  1820. static void
  1821. initialize_cut_buffers (display, window)
  1822.      Display *display;
  1823.      Window window;
  1824. {
  1825.   unsigned char *data = (unsigned char *) "";
  1826.   BLOCK_INPUT;
  1827. #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
  1828.                     PropModeAppend, data, 0)
  1829.   FROB (XA_CUT_BUFFER0);
  1830.   FROB (XA_CUT_BUFFER1);
  1831.   FROB (XA_CUT_BUFFER2);
  1832.   FROB (XA_CUT_BUFFER3);
  1833.   FROB (XA_CUT_BUFFER4);
  1834.   FROB (XA_CUT_BUFFER5);
  1835.   FROB (XA_CUT_BUFFER6);
  1836.   FROB (XA_CUT_BUFFER7);
  1837. #undef FROB
  1838.   UNBLOCK_INPUT;
  1839.   cut_buffers_initialized = 1;
  1840. }
  1841.  
  1842.  
  1843. #define CHECK_CUT_BUFFER(symbol,n)                    \
  1844.   { CHECK_SYMBOL ((symbol), (n));                    \
  1845.     if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1)    \
  1846.     && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3)    \
  1847.     && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5)    \
  1848.     && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))    \
  1849.       Fsignal (Qerror,                            \
  1850.            Fcons (build_string ("doesn't name a cut buffer"),    \
  1851.                  Fcons ((symbol), Qnil)));            \
  1852.   }
  1853.  
  1854. DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
  1855.   Sx_get_cut_buffer_internal, 1, 1, 0,
  1856.   "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
  1857.   (buffer)
  1858.      Lisp_Object buffer;
  1859. {
  1860.   Display *display = x_current_display;
  1861.   Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  1862.   Atom buffer_atom;
  1863.   unsigned char *data;
  1864.   int bytes;
  1865.   Atom type;
  1866.   int format;
  1867.   unsigned long size;
  1868.   Lisp_Object ret;
  1869.  
  1870.   check_x ();
  1871.   CHECK_CUT_BUFFER (buffer, 0);
  1872.   buffer_atom = symbol_to_x_atom (display, buffer);
  1873.  
  1874.   x_get_window_property (display, window, buffer_atom, &data, &bytes,
  1875.              &type, &format, &size, 0);
  1876.   if (!data) return Qnil;
  1877.   
  1878.   if (format != 8 || type != XA_STRING)
  1879.     Fsignal (Qerror,
  1880.          Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
  1881.             Fcons (x_atom_to_symbol (display, type),
  1882.                Fcons (make_number (format), Qnil))));
  1883.  
  1884.   ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
  1885.   xfree (data);
  1886.   return ret;
  1887. }
  1888.  
  1889.  
  1890. DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
  1891.   Sx_store_cut_buffer_internal, 2, 2, 0,
  1892.   "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
  1893.   (buffer, string)
  1894.      Lisp_Object buffer, string;
  1895. {
  1896.   Display *display = x_current_display;
  1897.   Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  1898.   Atom buffer_atom;
  1899.   unsigned char *data;
  1900.   int bytes;
  1901.   int bytes_remaining;
  1902.   int max_bytes = SELECTION_QUANTUM (display);
  1903.   if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
  1904.  
  1905.   check_x ();
  1906.   CHECK_CUT_BUFFER (buffer, 0);
  1907.   CHECK_STRING (string, 0);
  1908.   buffer_atom = symbol_to_x_atom (display, buffer);
  1909.   data = (unsigned char *) XSTRING (string)->data;
  1910.   bytes = XSTRING (string)->size;
  1911.   bytes_remaining = bytes;
  1912.  
  1913.   if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
  1914.  
  1915.   BLOCK_INPUT;
  1916.  
  1917.   /* Don't mess up with an empty value.  */
  1918.   if (!bytes_remaining)
  1919.     XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
  1920.              PropModeReplace, data, 0);
  1921.  
  1922.   while (bytes_remaining)
  1923.     {
  1924.       int chunk = (bytes_remaining < max_bytes
  1925.            ? bytes_remaining : max_bytes);
  1926.       XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
  1927.                (bytes_remaining == bytes
  1928.             ? PropModeReplace
  1929.             : PropModeAppend),
  1930.                data, chunk);
  1931.       data += chunk;
  1932.       bytes_remaining -= chunk;
  1933.     }
  1934.   UNBLOCK_INPUT;
  1935.   return string;
  1936. }
  1937.  
  1938.  
  1939. DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
  1940.   Sx_rotate_cut_buffers_internal, 1, 1, 0,
  1941.   "Rotate the values of the cut buffers by the given number of steps;\n\
  1942. positive means move values forward, negative means backward.")
  1943.   (n)
  1944.      Lisp_Object n;
  1945. {
  1946.   Display *display = x_current_display;
  1947.   Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
  1948.   Atom props [8];
  1949.  
  1950.   check_x ();
  1951.   CHECK_NUMBER (n, 0);
  1952.   if (XINT (n) == 0) return n;
  1953.   if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
  1954.   props[0] = XA_CUT_BUFFER0;
  1955.   props[1] = XA_CUT_BUFFER1;
  1956.   props[2] = XA_CUT_BUFFER2;
  1957.   props[3] = XA_CUT_BUFFER3;
  1958.   props[4] = XA_CUT_BUFFER4;
  1959.   props[5] = XA_CUT_BUFFER5;
  1960.   props[6] = XA_CUT_BUFFER6;
  1961.   props[7] = XA_CUT_BUFFER7;
  1962.   BLOCK_INPUT;
  1963.   XRotateWindowProperties (display, window, props, 8, XINT (n));
  1964.   UNBLOCK_INPUT;
  1965.   return n;
  1966. }
  1967.  
  1968. #endif
  1969.  
  1970. void
  1971. Xatoms_of_xselect ()
  1972. {
  1973. #define ATOM(x) XInternAtom (x_current_display, (x), False)
  1974.  
  1975.   BLOCK_INPUT;
  1976.   /* Non-predefined atoms that we might end up using a lot */
  1977.   Xatom_CLIPBOARD =    ATOM ("CLIPBOARD");
  1978.   Xatom_TIMESTAMP =    ATOM ("TIMESTAMP");
  1979.   Xatom_TEXT =        ATOM ("TEXT");
  1980.   Xatom_DELETE =    ATOM ("DELETE");
  1981.   Xatom_MULTIPLE =    ATOM ("MULTIPLE");
  1982.   Xatom_INCR =        ATOM ("INCR");
  1983.   Xatom_EMACS_TMP =    ATOM ("_EMACS_TMP_");
  1984.   Xatom_TARGETS =    ATOM ("TARGETS");
  1985.   Xatom_NULL =        ATOM ("NULL");
  1986.   Xatom_ATOM_PAIR =    ATOM ("ATOM_PAIR");
  1987.   UNBLOCK_INPUT;
  1988. }
  1989.  
  1990. void
  1991. syms_of_xselect ()
  1992. {
  1993.   defsubr (&Sx_get_selection_internal);
  1994.   defsubr (&Sx_own_selection_internal);
  1995.   defsubr (&Sx_disown_selection_internal);
  1996.   defsubr (&Sx_selection_owner_p);
  1997.   defsubr (&Sx_selection_exists_p);
  1998.  
  1999. #ifdef CUT_BUFFER_SUPPORT
  2000.   defsubr (&Sx_get_cut_buffer_internal);
  2001.   defsubr (&Sx_store_cut_buffer_internal);
  2002.   defsubr (&Sx_rotate_cut_buffers_internal);
  2003.   cut_buffers_initialized = 0;
  2004. #endif
  2005.  
  2006.   reading_selection_reply = Fcons (Qnil, Qnil);
  2007.   staticpro (&reading_selection_reply);
  2008.   reading_selection_window = 0;
  2009.   reading_which_selection = 0;
  2010.  
  2011.   property_change_wait_list = 0;
  2012.   prop_location_identifier = 0;
  2013.   property_change_reply = Fcons (Qnil, Qnil);
  2014.   staticpro (&property_change_reply);
  2015.  
  2016.   Vselection_alist = Qnil;
  2017.   staticpro (&Vselection_alist);
  2018.  
  2019.   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
  2020.   "An alist associating X Windows selection-types with functions.\n\
  2021. These functions are called to convert the selection, with three args:\n\
  2022. the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
  2023. a desired type to which the selection should be converted;\n\
  2024. and the local selection value (whatever was given to `x-own-selection').\n\
  2025. \n\
  2026. The function should return the value to send to the X server\n\
  2027. \(typically a string).  A return value of nil\n\
  2028. means that the conversion could not be done.\n\
  2029. A return value which is the symbol `NULL'\n\
  2030. means that a side-effect was executed,\n\
  2031. and there is no meaningful selection value.");
  2032.   Vselection_converter_alist = Qnil;
  2033.  
  2034.   DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
  2035.   "A list of functions to be called when Emacs loses an X selection.\n\
  2036. \(This happens when some other X client makes its own selection\n\
  2037. or when a Lisp program explicitly clears the selection.)\n\
  2038. The functions are called with one argument, the selection type\n\
  2039. \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
  2040.   Vx_lost_selection_hooks = Qnil;
  2041.  
  2042.   DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
  2043.   "A list of functions to be called when Emacs answers a selection request.\n\
  2044. The functions are called with four arguments:\n\
  2045.   - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
  2046.   - the selection-type which Emacs was asked to convert the\n\
  2047.     selection into before sending (for example, `STRING' or `LENGTH');\n\
  2048.   - a flag indicating success or failure for responding to the request.\n\
  2049. We might have failed (and declined the request) for any number of reasons,\n\
  2050. including being asked for a selection that we no longer own, or being asked\n\
  2051. to convert into a type that we don't know about or that is inappropriate.\n\
  2052. This hook doesn't let you change the behavior of Emacs's selection replies,\n\
  2053. it merely informs you that they have happened.");
  2054.   Vx_sent_selection_hooks = Qnil;
  2055.  
  2056.   DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
  2057.    "Number of milliseconds to wait for a selection reply.\n\
  2058. If the selection owner doens't reply in this time, we give up.\n\
  2059. A value of 0 means wait as long as necessary.  This is initialized from the\n\
  2060. \"*selectionTimeout\" resource.");
  2061.   x_selection_timeout = 0;
  2062.  
  2063.   QPRIMARY   = intern ("PRIMARY");    staticpro (&QPRIMARY);
  2064.   QSECONDARY = intern ("SECONDARY");    staticpro (&QSECONDARY);
  2065.   QSTRING    = intern ("STRING");    staticpro (&QSTRING);
  2066.   QINTEGER   = intern ("INTEGER");    staticpro (&QINTEGER);
  2067.   QCLIPBOARD = intern ("CLIPBOARD");    staticpro (&QCLIPBOARD);
  2068.   QTIMESTAMP = intern ("TIMESTAMP");    staticpro (&QTIMESTAMP);
  2069.   QTEXT      = intern ("TEXT");     staticpro (&QTEXT);
  2070.   QTIMESTAMP = intern ("TIMESTAMP");    staticpro (&QTIMESTAMP);
  2071.   QDELETE    = intern ("DELETE");    staticpro (&QDELETE);
  2072.   QMULTIPLE  = intern ("MULTIPLE");    staticpro (&QMULTIPLE);
  2073.   QINCR      = intern ("INCR");        staticpro (&QINCR);
  2074.   QEMACS_TMP = intern ("_EMACS_TMP_");    staticpro (&QEMACS_TMP);
  2075.   QTARGETS   = intern ("TARGETS");    staticpro (&QTARGETS);
  2076.   QATOM         = intern ("ATOM");        staticpro (&QATOM);
  2077.   QATOM_PAIR = intern ("ATOM_PAIR");    staticpro (&QATOM_PAIR);
  2078.   QNULL         = intern ("NULL");        staticpro (&QNULL);
  2079.  
  2080. #ifdef CUT_BUFFER_SUPPORT
  2081.   QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
  2082.   QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
  2083.   QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
  2084.   QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
  2085.   QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
  2086.   QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
  2087.   QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
  2088.   QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
  2089. #endif
  2090.  
  2091. }
  2092.