1 /* X Selection processing for Emacs.
   2    Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
   3                  2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   4 
   5 This file is part of GNU Emacs.
   6 
   7 GNU Emacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11 
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16 
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
  19 
  20 
  21 /* Rewritten by jwz */
  22 
  23 #include <config.h>
  24 #include <stdio.h>      /* termhooks.h needs this */
  25 #include <setjmp.h>
  26 
  27 #ifdef HAVE_SYS_TYPES_H
  28 #include <sys/types.h>
  29 #endif
  30 #ifdef HAVE_UNISTD_H
  31 #include <unistd.h>
  32 #endif
  33 
  34 #include "lisp.h"
  35 #include "xterm.h"      /* for all of the X includes */
  36 #include "dispextern.h" /* frame.h seems to want this */
  37 #include "frame.h"      /* Need this to get the X window of selected_frame */
  38 #include "blockinput.h"
  39 #include "buffer.h"
  40 #include "process.h"
  41 #include "termhooks.h"
  42 #include "keyboard.h"
  43 
  44 #include <X11/Xproto.h>
  45 
  46 struct prop_location;
  47 
  48 static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
  49 static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
  50                                   Lisp_Object));
  51 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
  52 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
  53 static void x_decline_selection_request P_ ((struct input_event *));
  54 static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
  55 static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
  56 static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
  57 static Lisp_Object x_catch_errors_unwind P_ ((Lisp_Object));
  58 static void x_reply_selection_request P_ ((struct input_event *, int,
  59                                            unsigned char *, int, Atom));
  60 static int waiting_for_other_props_on_window P_ ((Display *, Window));
  61 static struct prop_location *expect_property_change P_ ((Display *, Window,
  62                                                          Atom, int));
  63 static void unexpect_property_change P_ ((struct prop_location *));
  64 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
  65 static void wait_for_property_change P_ ((struct prop_location *));
  66 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
  67                                                 Lisp_Object,
  68                                                 Lisp_Object));
  69 static void x_get_window_property P_ ((Display *, Window, Atom,
  70                                        unsigned char **, int *,
  71                                        Atom *, int *, unsigned long *, int));
  72 static void receive_incremental_selection P_ ((Display *, Window, Atom,
  73                                                Lisp_Object, unsigned,
  74                                                unsigned char **, int *,
  75                                                Atom *, int *, unsigned long *));
  76 static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
  77                                                            Window, Atom,
  78                                                            Lisp_Object, Atom));
  79 static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
  80                                                     int, Atom, int));
  81 static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
  82                                              unsigned char **, Atom *,
  83                                              unsigned *, int *, int *));
  84 static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
  85 static void initialize_cut_buffers P_ ((Display *, Window));
  86 
  87 
  88 /* Printing traces to stderr.  */
  89 
  90 #ifdef TRACE_SELECTION
  91 #define TRACE0(fmt) \
  92   fprintf (stderr, "%d: " fmt "\n", getpid ())
  93 #define TRACE1(fmt, a0) \
  94   fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
  95 #define TRACE2(fmt, a0, a1) \
  96   fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
  97 #define TRACE3(fmt, a0, a1, a2) \
  98   fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
  99 #else
 100 #define TRACE0(fmt)             (void) 0
 101 #define TRACE1(fmt, a0)         (void) 0
 102 #define TRACE2(fmt, a0, a1)     (void) 0
 103 #define TRACE3(fmt, a0, a1)     (void) 0
 104 #endif
 105 
 106 
 107 #define CUT_BUFFER_SUPPORT
 108 
 109 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
 110   QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
 111   QATOM_PAIR;
 112 
 113 Lisp_Object QCOMPOUND_TEXT;     /* This is a type of selection.  */
 114 Lisp_Object QUTF8_STRING;       /* This is a type of selection.  */
 115 
 116 Lisp_Object Qcompound_text_with_extensions;
 117 
 118 #ifdef CUT_BUFFER_SUPPORT
 119 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
 120   QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
 121 #endif
 122 
 123 static Lisp_Object Vx_lost_selection_functions;
 124 static Lisp_Object Vx_sent_selection_functions;
 125 static Lisp_Object Qforeign_selection;
 126 
 127 /* If this is a smaller number than the max-request-size of the display,
 128    emacs will use INCR selection transfer when the selection is larger
 129    than this.  The max-request-size is usually around 64k, so if you want
 130    emacs to use incremental selection transfers when the selection is
 131    smaller than that, set this.  I added this mostly for debugging the
 132    incremental transfer stuff, but it might improve server performance.  */
 133 #define MAX_SELECTION_QUANTUM 0xFFFFFF
 134 
 135 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
 136 
 137 /* The timestamp of the last input event Emacs received from the X server.  */
 138 /* Defined in keyboard.c.  */
 139 extern unsigned long last_event_timestamp;
 140 
 141 /* This is an association list whose elements are of the form
 142      ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
 143    SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
 144    SELECTION-VALUE is the value that emacs owns for that selection.
 145      It may be any kind of Lisp object.
 146    SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
 147      as a cons of two 16-bit numbers (making a 32 bit time.)
 148    FRAME is the frame for which we made the selection.
 149    If there is an entry in this alist, then it can be assumed that Emacs owns
 150     that selection.
 151    The only (eq) parts of this list that are visible from Lisp are the
 152     selection-values.  */
 153 static Lisp_Object Vselection_alist;
 154 
 155 /* This is an alist whose CARs are selection-types (whose names are the same
 156    as the names of X Atoms) and whose CDRs are the names of Lisp functions to
 157    call to convert the given Emacs selection value to a string representing
 158    the given selection type.  This is for Lisp-level extension of the emacs
 159    selection handling.  */
 160 static Lisp_Object Vselection_converter_alist;
 161 
 162 /* If the selection owner takes too long to reply to a selection request,
 163    we give up on it.  This is in milliseconds (0 = no timeout.)  */
 164 static EMACS_INT x_selection_timeout;
 165 
 166 
 167 
 168 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
 169    handling.  */
 170 
 171 struct selection_event_queue
 172   {
 173     struct input_event event;
 174     struct selection_event_queue *next;
 175   };
 176 
 177 static struct selection_event_queue *selection_queue;
 178 
 179 /* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
 180 
 181 static int x_queue_selection_requests;
 182 
 183 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
 184 
 185 static void
 186 x_queue_event (event)
 187      struct input_event *event;
 188 {
 189   struct selection_event_queue *queue_tmp;
 190 
 191   /* Don't queue repeated requests.
 192      This only happens for large requests which uses the incremental protocol.  */
 193   for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
 194     {
 195       if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
 196         {
 197           TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
 198           x_decline_selection_request (event);
 199           return;
 200         }
 201     }
 202 
 203   queue_tmp
 204     = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
 205 
 206   if (queue_tmp != NULL)
 207     {
 208       TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
 209       queue_tmp->event = *event;
 210       queue_tmp->next = selection_queue;
 211       selection_queue = queue_tmp;
 212     }
 213 }
 214 
 215 /* Start queuing SELECTION_REQUEST_EVENT events.  */
 216 
 217 static void
 218 x_start_queuing_selection_requests ()
 219 {
 220   if (x_queue_selection_requests)
 221     abort ();
 222 
 223   x_queue_selection_requests++;
 224   TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
 225 }
 226 
 227 /* Stop queuing SELECTION_REQUEST_EVENT events.  */
 228 
 229 static void
 230 x_stop_queuing_selection_requests ()
 231 {
 232   TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
 233   --x_queue_selection_requests;
 234 
 235   /* Take all the queued events and put them back
 236      so that they get processed afresh.  */
 237 
 238   while (selection_queue != NULL)
 239     {
 240       struct selection_event_queue *queue_tmp = selection_queue;
 241       TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
 242       kbd_buffer_unget_event (&queue_tmp->event);
 243       selection_queue = queue_tmp->next;
 244       xfree ((char *)queue_tmp);
 245     }
 246 }
 247 
 248 
 249 /* This converts a Lisp symbol to a server Atom, avoiding a server
 250    roundtrip whenever possible.  */
 251 
 252 static Atom
 253 symbol_to_x_atom (dpyinfo, display, sym)
 254      struct x_display_info *dpyinfo;
 255      Display *display;
 256      Lisp_Object sym;
 257 {
 258   Atom val;
 259   if (NILP (sym))           return 0;
 260   if (EQ (sym, QPRIMARY))   return XA_PRIMARY;
 261   if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
 262   if (EQ (sym, QSTRING))    return XA_STRING;
 263   if (EQ (sym, QINTEGER))   return XA_INTEGER;
 264   if (EQ (sym, QATOM))      return XA_ATOM;
 265   if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
 266   if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
 267   if (EQ (sym, QTEXT))      return dpyinfo->Xatom_TEXT;
 268   if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
 269   if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
 270   if (EQ (sym, QDELETE))    return dpyinfo->Xatom_DELETE;
 271   if (EQ (sym, QMULTIPLE))  return dpyinfo->Xatom_MULTIPLE;
 272   if (EQ (sym, QINCR))      return dpyinfo->Xatom_INCR;
 273   if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
 274   if (EQ (sym, QTARGETS))   return dpyinfo->Xatom_TARGETS;
 275   if (EQ (sym, QNULL))      return dpyinfo->Xatom_NULL;
 276 #ifdef CUT_BUFFER_SUPPORT
 277   if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
 278   if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
 279   if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
 280   if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
 281   if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
 282   if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
 283   if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
 284   if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
 285 #endif
 286   if (!SYMBOLP (sym)) abort ();
 287 
 288   TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
 289   BLOCK_INPUT;
 290   val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
 291   UNBLOCK_INPUT;
 292   return val;
 293 }
 294 
 295 
 296 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
 297    and calls to intern whenever possible.  */
 298 
 299 static Lisp_Object
 300 x_atom_to_symbol (dpy, atom)
 301      Display *dpy;
 302      Atom atom;
 303 {
 304   struct x_display_info *dpyinfo;
 305   char *str;
 306   Lisp_Object val;
 307 
 308   if (! atom)
 309     return Qnil;
 310 
 311   switch (atom)
 312     {
 313     case XA_PRIMARY:
 314       return QPRIMARY;
 315     case XA_SECONDARY:
 316       return QSECONDARY;
 317     case XA_STRING:
 318       return QSTRING;
 319     case XA_INTEGER:
 320       return QINTEGER;
 321     case XA_ATOM:
 322       return QATOM;
 323 #ifdef CUT_BUFFER_SUPPORT
 324     case XA_CUT_BUFFER0:
 325       return QCUT_BUFFER0;
 326     case XA_CUT_BUFFER1:
 327       return QCUT_BUFFER1;
 328     case XA_CUT_BUFFER2:
 329       return QCUT_BUFFER2;
 330     case XA_CUT_BUFFER3:
 331       return QCUT_BUFFER3;
 332     case XA_CUT_BUFFER4:
 333       return QCUT_BUFFER4;
 334     case XA_CUT_BUFFER5:
 335       return QCUT_BUFFER5;
 336     case XA_CUT_BUFFER6:
 337       return QCUT_BUFFER6;
 338     case XA_CUT_BUFFER7:
 339       return QCUT_BUFFER7;
 340 #endif
 341     }
 342 
 343   dpyinfo = x_display_info_for_display (dpy);
 344   if (atom == dpyinfo->Xatom_CLIPBOARD)
 345     return QCLIPBOARD;
 346   if (atom == dpyinfo->Xatom_TIMESTAMP)
 347     return QTIMESTAMP;
 348   if (atom == dpyinfo->Xatom_TEXT)
 349     return QTEXT;
 350   if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
 351     return QCOMPOUND_TEXT;
 352   if (atom == dpyinfo->Xatom_UTF8_STRING)
 353     return QUTF8_STRING;
 354   if (atom == dpyinfo->Xatom_DELETE)
 355     return QDELETE;
 356   if (atom == dpyinfo->Xatom_MULTIPLE)
 357     return QMULTIPLE;
 358   if (atom == dpyinfo->Xatom_INCR)
 359     return QINCR;
 360   if (atom == dpyinfo->Xatom_EMACS_TMP)
 361     return QEMACS_TMP;
 362   if (atom == dpyinfo->Xatom_TARGETS)
 363     return QTARGETS;
 364   if (atom == dpyinfo->Xatom_NULL)
 365     return QNULL;
 366 
 367   BLOCK_INPUT;
 368   str = XGetAtomName (dpy, atom);
 369   UNBLOCK_INPUT;
 370   TRACE1 ("XGetAtomName --> %s", str);
 371   if (! str) return Qnil;
 372   val = intern (str);
 373   BLOCK_INPUT;
 374   /* This was allocated by Xlib, so use XFree.  */
 375   XFree (str);
 376   UNBLOCK_INPUT;
 377   return val;
 378 }
 379 
 380 /* Do protocol to assert ourself as a selection owner.
 381    Update the Vselection_alist so that we can reply to later requests for
 382    our selection.  */
 383 
 384 static void
 385 x_own_selection (selection_name, selection_value)
 386      Lisp_Object selection_name, selection_value;
 387 {
 388   struct frame *sf = SELECTED_FRAME ();
 389   Window selecting_window;
 390   Display *display;
 391   Time time = last_event_timestamp;
 392   Atom selection_atom;
 393   struct x_display_info *dpyinfo;
 394 
 395   if (! FRAME_X_P (sf))
 396     return;
 397 
 398   selecting_window = FRAME_X_WINDOW (sf);
 399   display = FRAME_X_DISPLAY (sf);
 400   dpyinfo = FRAME_X_DISPLAY_INFO (sf);
 401   
 402   CHECK_SYMBOL (selection_name);
 403   selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
 404 
 405   BLOCK_INPUT;
 406   x_catch_errors (display);
 407   XSetSelectionOwner (display, selection_atom, selecting_window, time);
 408   x_check_errors (display, "Can't set selection: %s");
 409   x_uncatch_errors ();
 410   UNBLOCK_INPUT;
 411 
 412   /* Now update the local cache */
 413   {
 414     Lisp_Object selection_time;
 415     Lisp_Object selection_data;
 416     Lisp_Object prev_value;
 417 
 418     selection_time = long_to_cons ((unsigned long) time);
 419     selection_data = Fcons (selection_name,
 420                             Fcons (selection_value,
 421                                    Fcons (selection_time,
 422                                           Fcons (selected_frame, Qnil))));
 423     prev_value = assq_no_quit (selection_name, Vselection_alist);
 424 
 425     Vselection_alist = Fcons (selection_data, Vselection_alist);
 426 
 427     /* If we already owned the selection, remove the old selection data.
 428        Perhaps we should destructively modify it instead.
 429        Don't use Fdelq as that may QUIT.  */
 430     if (!NILP (prev_value))
 431       {
 432         Lisp_Object rest;       /* we know it's not the CAR, so it's easy.  */
 433         for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
 434           if (EQ (prev_value, Fcar (XCDR (rest))))
 435             {
 436               XSETCDR (rest, Fcdr (XCDR (rest)));
 437               break;
 438             }
 439       }
 440   }
 441 }
 442 
 443 /* Given a selection-name and desired type, look up our local copy of
 444    the selection value and convert it to the type.
 445    The value is nil or a string.
 446    This function is used both for remote requests (LOCAL_REQUEST is zero)
 447    and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
 448 
 449    This calls random Lisp code, and may signal or gc.  */
 450 
 451 static Lisp_Object
 452 x_get_local_selection (selection_symbol, target_type, local_request)
 453      Lisp_Object selection_symbol, target_type;
 454      int local_request;
 455 {
 456   Lisp_Object local_value;
 457   Lisp_Object handler_fn, value, type, check;
 458   int count;
 459 
 460   local_value = assq_no_quit (selection_symbol, Vselection_alist);
 461 
 462   if (NILP (local_value)) return Qnil;
 463 
 464   /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest.  */
 465   if (EQ (target_type, QTIMESTAMP))
 466     {
 467       handler_fn = Qnil;
 468       value = XCAR (XCDR (XCDR (local_value)));
 469     }
 470 #if 0
 471   else if (EQ (target_type, QDELETE))
 472     {
 473       handler_fn = Qnil;
 474       Fx_disown_selection_internal
 475         (selection_symbol,
 476          XCAR (XCDR (XCDR (local_value))));
 477       value = QNULL;
 478     }
 479 #endif
 480 
 481 #if 0 /* #### MULTIPLE doesn't work yet */
 482   else if (CONSP (target_type)
 483            && XCAR (target_type) == QMULTIPLE)
 484     {
 485       Lisp_Object pairs;
 486       int size;
 487       int i;
 488       pairs = XCDR (target_type);
 489       size = XVECTOR (pairs)->size;
 490       /* If the target is MULTIPLE, then target_type looks like
 491           (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
 492          We modify the second element of each pair in the vector and
 493          return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
 494        */
 495       for (i = 0; i < size; i++)
 496         {
 497           Lisp_Object pair;
 498           pair = XVECTOR (pairs)->contents [i];
 499           XVECTOR (pair)->contents [1]
 500             = x_get_local_selection (XVECTOR (pair)->contents [0],
 501                                      XVECTOR (pair)->contents [1],
 502                                      local_request);
 503         }
 504       return pairs;
 505     }
 506 #endif
 507   else
 508     {
 509       /* Don't allow a quit within the converter.
 510          When the user types C-g, he would be surprised
 511          if by luck it came during a converter.  */
 512       count = SPECPDL_INDEX ();
 513       specbind (Qinhibit_quit, Qt);
 514 
 515       CHECK_SYMBOL (target_type);
 516       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 517       /* gcpro is not needed here since nothing but HANDLER_FN
 518          is live, and that ought to be a symbol.  */
 519 
 520       if (!NILP (handler_fn))
 521         value = call3 (handler_fn,
 522                        selection_symbol, (local_request ? Qnil : target_type),
 523                        XCAR (XCDR (local_value)));
 524       else
 525         value = Qnil;
 526       unbind_to (count, Qnil);
 527     }
 528 
 529   /* Make sure this value is of a type that we could transmit
 530      to another X client.  */
 531 
 532   check = value;
 533   if (CONSP (value)
 534       && SYMBOLP (XCAR (value)))
 535     type = XCAR (value),
 536     check = XCDR (value);
 537 
 538   if (STRINGP (check)
 539       || VECTORP (check)
 540       || SYMBOLP (check)
 541       || INTEGERP (check)
 542       || NILP (value))
 543     return value;
 544   /* Check for a value that cons_to_long could handle.  */
 545   else if (CONSP (check)
 546            && INTEGERP (XCAR (check))
 547            && (INTEGERP (XCDR (check))
 548                ||
 549                (CONSP (XCDR (check))
 550                 && INTEGERP (XCAR (XCDR (check)))
 551                 && NILP (XCDR (XCDR (check))))))
 552     return value;
 553 
 554   signal_error ("Invalid data returned by selection-conversion function",
 555                 list2 (handler_fn, value));
 556 }
 557 
 558 /* Subroutines of x_reply_selection_request.  */
 559 
 560 /* Send a SelectionNotify event to the requestor with property=None,
 561    meaning we were unable to do what they wanted.  */
 562 
 563 static void
 564 x_decline_selection_request (event)
 565      struct input_event *event;
 566 {
 567   XSelectionEvent reply;
 568 
 569   reply.type = SelectionNotify;
 570   reply.display = SELECTION_EVENT_DISPLAY (event);
 571   reply.requestor = SELECTION_EVENT_REQUESTOR (event);
 572   reply.selection = SELECTION_EVENT_SELECTION (event);
 573   reply.time = SELECTION_EVENT_TIME (event);
 574   reply.target = SELECTION_EVENT_TARGET (event);
 575   reply.property = None;
 576 
 577   /* The reason for the error may be that the receiver has
 578      died in the meantime.  Handle that case.  */
 579   BLOCK_INPUT;
 580   x_catch_errors (reply.display);
 581   XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
 582   XFlush (reply.display);
 583   x_uncatch_errors ();
 584   UNBLOCK_INPUT;
 585 }
 586 
 587 /* This is the selection request currently being processed.
 588    It is set to zero when the request is fully processed.  */
 589 static struct input_event *x_selection_current_request;
 590 
 591 /* Display info in x_selection_request.  */
 592 
 593 static struct x_display_info *selection_request_dpyinfo;
 594 
 595 /* Used as an unwind-protect clause so that, if a selection-converter signals
 596    an error, we tell the requester that we were unable to do what they wanted
 597    before we throw to top-level or go into the debugger or whatever.  */
 598 
 599 static Lisp_Object
 600 x_selection_request_lisp_error (ignore)
 601      Lisp_Object ignore;
 602 {
 603   if (x_selection_current_request != 0
 604       && selection_request_dpyinfo->display)
 605     x_decline_selection_request (x_selection_current_request);
 606   return Qnil;
 607 }
 608 
 609 static Lisp_Object
 610 x_catch_errors_unwind (dummy)
 611      Lisp_Object dummy;
 612 {
 613   BLOCK_INPUT;
 614   x_uncatch_errors ();
 615   UNBLOCK_INPUT;
 616   return Qnil;
 617 }
 618 
 619 
 620 /* This stuff is so that INCR selections are reentrant (that is, so we can
 621    be servicing multiple INCR selection requests simultaneously.)  I haven't
 622    actually tested that yet.  */
 623 
 624 /* Keep a list of the property changes that are awaited.  */
 625 
 626 struct prop_location
 627 {
 628   int identifier;
 629   Display *display;
 630   Window window;
 631   Atom property;
 632   int desired_state;
 633   int arrived;
 634   struct prop_location *next;
 635 };
 636 
 637 static struct prop_location *expect_property_change ();
 638 static void wait_for_property_change ();
 639 static void unexpect_property_change ();
 640 static int waiting_for_other_props_on_window ();
 641 
 642 static int prop_location_identifier;
 643 
 644 static Lisp_Object property_change_reply;
 645 
 646 static struct prop_location *property_change_reply_object;
 647 
 648 static struct prop_location *property_change_wait_list;
 649 
 650 static Lisp_Object
 651 queue_selection_requests_unwind (tem)
 652      Lisp_Object tem;
 653 {
 654   x_stop_queuing_selection_requests ();
 655   return Qnil;
 656 }
 657 
 658 /* Return some frame whose display info is DPYINFO.
 659    Return nil if there is none.  */
 660 
 661 static Lisp_Object
 662 some_frame_on_display (dpyinfo)
 663      struct x_display_info *dpyinfo;
 664 {
 665   Lisp_Object list, frame;
 666 
 667   FOR_EACH_FRAME (list, frame)
 668     {
 669       if (FRAME_X_P (XFRAME (frame))
 670           && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
 671         return frame;
 672     }
 673 
 674   return Qnil;
 675 }
 676 
 677 /* Send the reply to a selection request event EVENT.
 678    TYPE is the type of selection data requested.
 679    DATA and SIZE describe the data to send, already converted.
 680    FORMAT is the unit-size (in bits) of the data to be transmitted.  */
 681 
 682 #ifdef TRACE_SELECTION
 683 static int x_reply_selection_request_cnt;
 684 #endif  /* TRACE_SELECTION */
 685 
 686 static void
 687 x_reply_selection_request (event, format, data, size, type)
 688      struct input_event *event;
 689      int format, size;
 690      unsigned char *data;
 691      Atom type;
 692 {
 693   XSelectionEvent reply;
 694   Display *display = SELECTION_EVENT_DISPLAY (event);
 695   Window window = SELECTION_EVENT_REQUESTOR (event);
 696   int bytes_remaining;
 697   int format_bytes = format/8;
 698   int max_bytes = SELECTION_QUANTUM (display);
 699   struct x_display_info *dpyinfo = x_display_info_for_display (display);
 700   int count = SPECPDL_INDEX ();
 701 
 702   if (max_bytes > MAX_SELECTION_QUANTUM)
 703     max_bytes = MAX_SELECTION_QUANTUM;
 704 
 705   reply.type = SelectionNotify;
 706   reply.display = display;
 707   reply.requestor = window;
 708   reply.selection = SELECTION_EVENT_SELECTION (event);
 709   reply.time = SELECTION_EVENT_TIME (event);
 710   reply.target = SELECTION_EVENT_TARGET (event);
 711   reply.property = SELECTION_EVENT_PROPERTY (event);
 712   if (reply.property == None)
 713     reply.property = reply.target;
 714 
 715   BLOCK_INPUT;
 716   /* The protected block contains wait_for_property_change, which can
 717      run random lisp code (process handlers) or signal.  Therefore, we
 718      put the x_uncatch_errors call in an unwind.  */
 719   record_unwind_protect (x_catch_errors_unwind, Qnil);
 720   x_catch_errors (display);
 721 
 722 #ifdef TRACE_SELECTION
 723   {
 724     char *sel = XGetAtomName (display, reply.selection);
 725     char *tgt = XGetAtomName (display, reply.target);
 726     TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
 727     if (sel) XFree (sel);
 728     if (tgt) XFree (tgt);
 729   }
 730 #endif /* TRACE_SELECTION */
 731 
 732   /* Store the data on the requested property.
 733      If the selection is large, only store the first N bytes of it.
 734    */
 735   bytes_remaining = size * format_bytes;
 736   if (bytes_remaining <= max_bytes)
 737     {
 738       /* Send all the data at once, with minimal handshaking.  */
 739       TRACE1 ("Sending all %d bytes", bytes_remaining);
 740       XChangeProperty (display, window, reply.property, type, format,
 741                        PropModeReplace, data, size);
 742       /* At this point, the selection was successfully stored; ack it.  */
 743       XSendEvent (display, window, False, 0L, (XEvent *) &reply);
 744     }
 745   else
 746     {
 747       /* Send an INCR selection.  */
 748       struct prop_location *wait_object;
 749       int had_errors;
 750       Lisp_Object frame;
 751 
 752       frame = some_frame_on_display (dpyinfo);
 753 
 754       /* If the display no longer has frames, we can't expect
 755          to get many more selection requests from it, so don't
 756          bother trying to queue them.  */
 757       if (!NILP (frame))
 758         {
 759           x_start_queuing_selection_requests ();
 760 
 761           record_unwind_protect (queue_selection_requests_unwind,
 762                                  Qnil);
 763         }
 764 
 765       if (x_window_to_frame (dpyinfo, window)) /* #### debug */
 766         error ("Attempt to transfer an INCR to ourself!");
 767 
 768       TRACE2 ("Start sending %d bytes incrementally (%s)",
 769               bytes_remaining,  XGetAtomName (display, reply.property));
 770       wait_object = expect_property_change (display, window, reply.property,
 771                                             PropertyDelete);
 772 
 773       TRACE1 ("Set %s to number of bytes to send",
 774               XGetAtomName (display, reply.property));
 775       {
 776         /* XChangeProperty expects an array of long even if long is more than
 777            32 bits.  */
 778         long value[1];
 779 
 780         value[0] = bytes_remaining;
 781         XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
 782                          32, PropModeReplace,
 783                          (unsigned char *) value, 1);
 784       }
 785 
 786       XSelectInput (display, window, PropertyChangeMask);
 787 
 788       /* Tell 'em the INCR data is there...  */
 789       TRACE0 ("Send SelectionNotify event");
 790       XSendEvent (display, window, False, 0L, (XEvent *) &reply);
 791       XFlush (display);
 792 
 793       had_errors = x_had_errors_p (display);
 794       UNBLOCK_INPUT;
 795 
 796       /* First, wait for the requester to ack by deleting the property.
 797          This can run random lisp code (process handlers) or signal.  */
 798       if (! had_errors)
 799         {
 800           TRACE1 ("Waiting for ACK (deletion of %s)",
 801                   XGetAtomName (display, reply.property));
 802           wait_for_property_change (wait_object);
 803         }
 804       else
 805         unexpect_property_change (wait_object);
 806 
 807       TRACE0 ("Got ACK");
 808       while (bytes_remaining)
 809         {
 810           int i = ((bytes_remaining < max_bytes)
 811                    ? bytes_remaining
 812                    : max_bytes) / format_bytes;
 813 
 814           BLOCK_INPUT;
 815 
 816           wait_object
 817             = expect_property_change (display, window, reply.property,
 818                                       PropertyDelete);
 819 
 820           TRACE1 ("Sending increment of %d elements", i);
 821           TRACE1 ("Set %s to increment data",
 822                   XGetAtomName (display, reply.property));
 823 
 824           /* Append the next chunk of data to the property.  */
 825           XChangeProperty (display, window, reply.property, type, format,
 826                            PropModeAppend, data, i);
 827           bytes_remaining -= i * format_bytes;
 828           if (format == 32)
 829             data += i * sizeof (long);
 830           else
 831             data += i * format_bytes;
 832           XFlush (display);
 833           had_errors = x_had_errors_p (display);
 834           UNBLOCK_INPUT;
 835 
 836           if (had_errors)
 837             break;
 838 
 839           /* Now wait for the requester to ack this chunk by deleting the
 840              property.  This can run random lisp code or signal.  */
 841           TRACE1 ("Waiting for increment ACK (deletion of %s)",
 842                   XGetAtomName (display, reply.property));
 843           wait_for_property_change (wait_object);
 844         }
 845 
 846       /* Now write a zero-length chunk to the property to tell the
 847          requester that we're done.  */
 848       BLOCK_INPUT;
 849       if (! waiting_for_other_props_on_window (display, window))
 850         XSelectInput (display, window, 0L);
 851 
 852       TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
 853               XGetAtomName (display, reply.property));
 854       XChangeProperty (display, window, reply.property, type, format,
 855                        PropModeReplace, data, 0);
 856       TRACE0 ("Done sending incrementally");
 857     }
 858 
 859   /* rms, 2003-01-03: I think I have fixed this bug.  */
 860   /* The window we're communicating with may have been deleted
 861      in the meantime (that's a real situation from a bug report).
 862      In this case, there may be events in the event queue still
 863      refering to the deleted window, and we'll get a BadWindow error
 864      in XTread_socket when processing the events.  I don't have
 865      an idea how to fix that.  gerd, 2001-01-98.   */
 866   /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
 867      delivered before uncatch errors.  */
 868   XSync (display, False);
 869   UNBLOCK_INPUT;
 870 
 871   /* GTK queues events in addition to the queue in Xlib.  So we
 872      UNBLOCK to enter the event loop and get possible errors delivered,
 873      and then BLOCK again because x_uncatch_errors requires it.  */
 874   BLOCK_INPUT;
 875   /* This calls x_uncatch_errors.  */
 876   unbind_to (count, Qnil);
 877   UNBLOCK_INPUT;
 878 }
 879 
 880 /* Handle a SelectionRequest event EVENT.
 881    This is called from keyboard.c when such an event is found in the queue.  */
 882 
 883 static void
 884 x_handle_selection_request (event)
 885      struct input_event *event;
 886 {
 887   struct gcpro gcpro1, gcpro2, gcpro3;
 888   Lisp_Object local_selection_data;
 889   Lisp_Object selection_symbol;
 890   Lisp_Object target_symbol;
 891   Lisp_Object converted_selection;
 892   Time local_selection_time;
 893   Lisp_Object successful_p;
 894   int count;
 895   struct x_display_info *dpyinfo
 896     = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
 897 
 898   TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
 899           (unsigned long) SELECTION_EVENT_REQUESTOR (event),
 900           (unsigned long) SELECTION_EVENT_TIME (event));
 901 
 902   local_selection_data = Qnil;
 903   target_symbol = Qnil;
 904   converted_selection = Qnil;
 905   successful_p = Qnil;
 906 
 907   GCPRO3 (local_selection_data, converted_selection, target_symbol);
 908 
 909   selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
 910                                        SELECTION_EVENT_SELECTION (event));
 911 
 912   local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
 913 
 914   if (NILP (local_selection_data))
 915     {
 916       /* Someone asked for the selection, but we don't have it any more.
 917        */
 918       x_decline_selection_request (event);
 919       goto DONE;
 920     }
 921 
 922   local_selection_time = (Time)
 923     cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
 924 
 925   if (SELECTION_EVENT_TIME (event) != CurrentTime
 926       && local_selection_time > SELECTION_EVENT_TIME (event))
 927     {
 928       /* Someone asked for the selection, and we have one, but not the one
 929          they're looking for.
 930        */
 931       x_decline_selection_request (event);
 932       goto DONE;
 933     }
 934 
 935   x_selection_current_request = event;
 936   count = SPECPDL_INDEX ();
 937   selection_request_dpyinfo = dpyinfo;
 938   record_unwind_protect (x_selection_request_lisp_error, Qnil);
 939 
 940   target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
 941                                     SELECTION_EVENT_TARGET (event));
 942 
 943 #if 0 /* #### MULTIPLE doesn't work yet */
 944   if (EQ (target_symbol, QMULTIPLE))
 945     target_symbol = fetch_multiple_target (event);
 946 #endif
 947 
 948   /* Convert lisp objects back into binary data */
 949 
 950   converted_selection
 951     = x_get_local_selection (selection_symbol, target_symbol, 0);
 952 
 953   if (! NILP (converted_selection))
 954     {
 955       unsigned char *data;
 956       unsigned int size;
 957       int format;
 958       Atom type;
 959       int nofree;
 960 
 961       if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
 962         {
 963           x_decline_selection_request (event);
 964           goto DONE2;
 965         }
 966 
 967       lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
 968                                    converted_selection,
 969                                    &data, &type, &size, &format, &nofree);
 970 
 971       x_reply_selection_request (event, format, data, size, type);
 972       successful_p = Qt;
 973 
 974       /* Indicate we have successfully processed this event.  */
 975       x_selection_current_request = 0;
 976 
 977       /* Use xfree, not XFree, because lisp_data_to_selection_data
 978          calls xmalloc itself.  */
 979       if (!nofree)
 980         xfree (data);
 981     }
 982 
 983  DONE2:
 984   unbind_to (count, Qnil);
 985 
 986  DONE:
 987 
 988   /* Let random lisp code notice that the selection has been asked for.  */
 989   {
 990     Lisp_Object rest;
 991     rest = Vx_sent_selection_functions;
 992     if (!EQ (rest, Qunbound))
 993       for (; CONSP (rest); rest = Fcdr (rest))
 994         call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
 995   }
 996 
 997   UNGCPRO;
 998 }
 999 
1000 /* Handle a SelectionClear event EVENT, which indicates that some
1001    client cleared out our previously asserted selection.
1002    This is called from keyboard.c when such an event is found in the queue.  */
1003 
1004 static void
1005 x_handle_selection_clear (event)
1006      struct input_event *event;
1007 {
1008   Display *display = SELECTION_EVENT_DISPLAY (event);
1009   Atom selection = SELECTION_EVENT_SELECTION (event);
1010   Time changed_owner_time = SELECTION_EVENT_TIME (event);
1011 
1012   Lisp_Object selection_symbol, local_selection_data;
1013   Time local_selection_time;
1014   struct x_display_info *dpyinfo = x_display_info_for_display (display);
1015   struct x_display_info *t_dpyinfo;
1016 
1017   TRACE0 ("x_handle_selection_clear");
1018 
1019   /* If the new selection owner is also Emacs,
1020      don't clear the new selection.  */
1021   BLOCK_INPUT;
1022   /* Check each display on the same terminal,
1023      to see if this Emacs job now owns the selection
1024      through that display.  */
1025   for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1026     if (t_dpyinfo->terminal->kboard == dpyinfo->terminal->kboard)
1027       {
1028         Window owner_window
1029           = XGetSelectionOwner (t_dpyinfo->display, selection);
1030         if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1031           {
1032             UNBLOCK_INPUT;
1033             return;
1034           }
1035       }
1036   UNBLOCK_INPUT;
1037   
1038   selection_symbol = x_atom_to_symbol (display, selection);
1039 
1040   local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1041 
1042   /* Well, we already believe that we don't own it, so that's just fine.  */
1043   if (NILP (local_selection_data)) return;
1044 
1045   local_selection_time = (Time)
1046     cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
1047 
1048   /* This SelectionClear is for a selection that we no longer own, so we can
1049      disregard it.  (That is, we have reasserted the selection since this
1050      request was generated.)  */
1051 
1052   if (changed_owner_time != CurrentTime
1053       && local_selection_time > changed_owner_time)
1054     return;
1055 
1056   /* Otherwise, we're really honest and truly being told to drop it.
1057      Don't use Fdelq as that may QUIT;.  */
1058 
1059   if (EQ (local_selection_data, Fcar (Vselection_alist)))
1060     Vselection_alist = Fcdr (Vselection_alist);
1061   else
1062     {
1063       Lisp_Object rest;
1064       for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
1065         if (EQ (local_selection_data, Fcar (XCDR (rest))))
1066           {
1067             XSETCDR (rest, Fcdr (XCDR (rest)));
1068             break;
1069           }
1070     }
1071 
1072   /* Let random lisp code notice that the selection has been stolen.  */
1073 
1074   {
1075     Lisp_Object rest;
1076     rest = Vx_lost_selection_functions;
1077     if (!EQ (rest, Qunbound))
1078       {
1079         for (; CONSP (rest); rest = Fcdr (rest))
1080           call1 (Fcar (rest), selection_symbol);
1081         prepare_menu_bars ();
1082         redisplay_preserve_echo_area (20);
1083       }
1084   }
1085 }
1086 
1087 void
1088 x_handle_selection_event (event)
1089      struct input_event *event;
1090 {
1091   TRACE0 ("x_handle_selection_event");
1092 
1093   if (event->kind == SELECTION_REQUEST_EVENT)
1094     {
1095       if (x_queue_selection_requests)
1096         x_queue_event (event);
1097       else
1098         x_handle_selection_request (event);
1099     }
1100   else
1101     x_handle_selection_clear (event);
1102 }
1103 
1104 
1105 /* Clear all selections that were made from frame F.
1106    We do this when about to delete a frame.  */
1107 
1108 void
1109 x_clear_frame_selections (f)
1110      FRAME_PTR f;
1111 {
1112   Lisp_Object frame;
1113   Lisp_Object rest;
1114 
1115   XSETFRAME (frame, f);
1116 
1117   /* Otherwise, we're really honest and truly being told to drop it.
1118      Don't use Fdelq as that may QUIT;.  */
1119 
1120   /* Delete elements from the beginning of Vselection_alist.  */
1121   while (!NILP (Vselection_alist)
1122          && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1123     {
1124       /* Let random Lisp code notice that the selection has been stolen.  */
1125       Lisp_Object hooks, selection_symbol;
1126 
1127       hooks = Vx_lost_selection_functions;
1128       selection_symbol = Fcar (Fcar (Vselection_alist));
1129 
1130       if (!EQ (hooks, Qunbound))
1131         {
1132           for (; CONSP (hooks); hooks = Fcdr (hooks))
1133             call1 (Fcar (hooks), selection_symbol);
1134 #if 0 /* This can crash when deleting a frame
1135          from x_connection_closed.  Anyway, it seems unnecessary;
1136          something else should cause a redisplay.  */
1137           redisplay_preserve_echo_area (21);
1138 #endif
1139         }
1140 
1141       Vselection_alist = Fcdr (Vselection_alist);
1142     }
1143 
1144   /* Delete elements after the beginning of Vselection_alist.  */
1145   for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
1146     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
1147       {
1148         /* Let random Lisp code notice that the selection has been stolen.  */
1149         Lisp_Object hooks, selection_symbol;
1150 
1151         hooks = Vx_lost_selection_functions;
1152         selection_symbol = Fcar (Fcar (XCDR (rest)));
1153 
1154         if (!EQ (hooks, Qunbound))
1155           {
1156             for (; CONSP (hooks); hooks = Fcdr (hooks))
1157               call1 (Fcar (hooks), selection_symbol);
1158 #if 0 /* See above */
1159             redisplay_preserve_echo_area (22);
1160 #endif
1161           }
1162         XSETCDR (rest, Fcdr (XCDR (rest)));
1163         break;
1164       }
1165 }
1166 
1167 /* Nonzero if any properties for DISPLAY and WINDOW
1168    are on the list of what we are waiting for.  */
1169 
1170 static int
1171 waiting_for_other_props_on_window (display, window)
1172      Display *display;
1173      Window window;
1174 {
1175   struct prop_location *rest = property_change_wait_list;
1176   while (rest)
1177     if (rest->display == display && rest->window == window)
1178       return 1;
1179     else
1180       rest = rest->next;
1181   return 0;
1182 }
1183 
1184 /* Add an entry to the list of property changes we are waiting for.
1185    DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1186    The return value is a number that uniquely identifies
1187    this awaited property change.  */
1188 
1189 static struct prop_location *
1190 expect_property_change (display, window, property, state)
1191      Display *display;
1192      Window window;
1193      Atom property;
1194      int state;
1195 {
1196   struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1197   pl->identifier = ++prop_location_identifier;
1198   pl->display = display;
1199   pl->window = window;
1200   pl->property = property;
1201   pl->desired_state = state;
1202   pl->next = property_change_wait_list;
1203   pl->arrived = 0;
1204   property_change_wait_list = pl;
1205   return pl;
1206 }
1207 
1208 /* Delete an entry from the list of property changes we are waiting for.
1209    IDENTIFIER is the number that uniquely identifies the entry.  */
1210 
1211 static void
1212 unexpect_property_change (location)
1213      struct prop_location *location;
1214 {
1215   struct prop_location *prev = 0, *rest = property_change_wait_list;
1216   while (rest)
1217     {
1218       if (rest == location)
1219         {
1220           if (prev)
1221             prev->next = rest->next;
1222           else
1223             property_change_wait_list = rest->next;
1224           xfree (rest);
1225           return;
1226         }
1227       prev = rest;
1228       rest = rest->next;
1229     }
1230 }
1231 
1232 /* Remove the property change expectation element for IDENTIFIER.  */
1233 
1234 static Lisp_Object
1235 wait_for_property_change_unwind (loc)
1236      Lisp_Object loc;
1237 {
1238   struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1239 
1240   unexpect_property_change (location);
1241   if (location == property_change_reply_object)
1242     property_change_reply_object = 0;
1243   return Qnil;
1244 }
1245 
1246 /* Actually wait for a property change.
1247    IDENTIFIER should be the value that expect_property_change returned.  */
1248 
1249 static void
1250 wait_for_property_change (location)
1251      struct prop_location *location;
1252 {
1253   int secs, usecs;
1254   int count = SPECPDL_INDEX ();
1255 
1256   if (property_change_reply_object)
1257     abort ();
1258 
1259   /* Make sure to do unexpect_property_change if we quit or err.  */
1260   record_unwind_protect (wait_for_property_change_unwind,
1261                          make_save_value (location, 0));
1262 
1263   XSETCAR (property_change_reply, Qnil);
1264   property_change_reply_object = location;
1265 
1266   /* If the event we are waiting for arrives beyond here, it will set
1267      property_change_reply, because property_change_reply_object says so.  */
1268   if (! location->arrived)
1269     {
1270       secs = x_selection_timeout / 1000;
1271       usecs = (x_selection_timeout % 1000) * 1000;
1272       TRACE2 ("  Waiting %d secs, %d usecs", secs, usecs);
1273       wait_reading_process_output (secs, usecs, 0, 0,
1274                                    property_change_reply, NULL, 0);
1275 
1276       if (NILP (XCAR (property_change_reply)))
1277         {
1278           TRACE0 ("  Timed out");
1279           error ("Timed out waiting for property-notify event");
1280         }
1281     }
1282 
1283   unbind_to (count, Qnil);
1284 }
1285 
1286 /* Called from XTread_socket in response to a PropertyNotify event.  */
1287 
1288 void
1289 x_handle_property_notify (event)
1290      XPropertyEvent *event;
1291 {
1292   struct prop_location *prev = 0, *rest = property_change_wait_list;
1293 
1294   while (rest)
1295     {
1296       if (!rest->arrived
1297           && rest->property == event->atom
1298           && rest->window == event->window
1299           && rest->display == event->display
1300           && rest->desired_state == event->state)
1301         {
1302           TRACE2 ("Expected %s of property %s",
1303                   (event->state == PropertyDelete ? "deletion" : "change"),
1304                   XGetAtomName (event->display, event->atom));
1305 
1306           rest->arrived = 1;
1307 
1308           /* If this is the one wait_for_property_change is waiting for,
1309              tell it to wake up.  */
1310           if (rest == property_change_reply_object)
1311             XSETCAR (property_change_reply, Qt);
1312 
1313           return;
1314         }
1315 
1316       prev = rest;
1317       rest = rest->next;
1318     }
1319 }
1320 
1321 
1322 
1323 #if 0 /* #### MULTIPLE doesn't work yet */
1324 
1325 static Lisp_Object
1326 fetch_multiple_target (event)
1327      XSelectionRequestEvent *event;
1328 {
1329   Display *display = event->display;
1330   Window window = event->requestor;
1331   Atom target = event->target;
1332   Atom selection_atom = event->selection;
1333   int result;
1334 
1335   return
1336     Fcons (QMULTIPLE,
1337            x_get_window_property_as_lisp_data (display, window, target,
1338                                                QMULTIPLE, selection_atom));
1339 }
1340 
1341 static Lisp_Object
1342 copy_multiple_data (obj)
1343      Lisp_Object obj;
1344 {
1345   Lisp_Object vec;
1346   int i;
1347   int size;
1348   if (CONSP (obj))
1349     return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1350 
1351   CHECK_VECTOR (obj);
1352   vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1353   for (i = 0; i < size; i++)
1354     {
1355       Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1356       CHECK_VECTOR (vec2);
1357       if (XVECTOR (vec2)->size != 2)
1358         /* ??? Confusing error message */
1359         signal_error ("Vectors must be of length 2", vec2);
1360       XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1361       XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1362         = XVECTOR (vec2)->contents [0];
1363       XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1364         = XVECTOR (vec2)->contents [1];
1365     }
1366   return vec;
1367 }
1368 
1369 #endif
1370 
1371 
1372 /* Variables for communication with x_handle_selection_notify.  */
1373 static Atom reading_which_selection;
1374 static Lisp_Object reading_selection_reply;
1375 static Window reading_selection_window;
1376 
1377 /* Do protocol to read selection-data from the server.
1378    Converts this to Lisp data and returns it.  */
1379 
1380 static Lisp_Object
1381 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1382      Lisp_Object selection_symbol, target_type, time_stamp;
1383 {
1384   struct frame *sf = SELECTED_FRAME ();
1385   Window requestor_window;
1386   Display *display;
1387   struct x_display_info *dpyinfo;
1388   Time requestor_time = last_event_timestamp;
1389   Atom target_property;
1390   Atom selection_atom;
1391   Atom type_atom;
1392   int secs, usecs;
1393   int count = SPECPDL_INDEX ();
1394   Lisp_Object frame;
1395 
1396   if (! FRAME_X_P (sf))
1397     return Qnil;
1398 
1399   requestor_window = FRAME_X_WINDOW (sf);
1400   display = FRAME_X_DISPLAY (sf);
1401   dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1402   target_property = dpyinfo->Xatom_EMACS_TMP;
1403   selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1404 
1405   if (CONSP (target_type))
1406     type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1407   else
1408     type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1409 
1410   if (! NILP (time_stamp))
1411     {
1412       if (CONSP (time_stamp))
1413         requestor_time = (Time) cons_to_long (time_stamp);
1414       else if (INTEGERP (time_stamp))
1415         requestor_time = (Time) XUINT (time_stamp);
1416       else if (FLOATP (time_stamp))
1417         requestor_time = (Time) XFLOAT_DATA (time_stamp);
1418       else
1419         error ("TIME_STAMP must be cons or number");
1420     }
1421 
1422   BLOCK_INPUT;
1423 
1424   /* The protected block contains wait_reading_process_output, which
1425      can run random lisp code (process handlers) or signal.
1426      Therefore, we put the x_uncatch_errors call in an unwind.  */
1427   record_unwind_protect (x_catch_errors_unwind, Qnil);
1428   x_catch_errors (display);
1429 
1430   TRACE2 ("Get selection %s, type %s",
1431           XGetAtomName (display, type_atom),
1432           XGetAtomName (display, target_property));
1433 
1434   XConvertSelection (display, selection_atom, type_atom, target_property,
1435                      requestor_window, requestor_time);
1436   XFlush (display);
1437 
1438   /* Prepare to block until the reply has been read.  */
1439   reading_selection_window = requestor_window;
1440   reading_which_selection = selection_atom;
1441   XSETCAR (reading_selection_reply, Qnil);
1442 
1443   frame = some_frame_on_display (dpyinfo);
1444 
1445   /* If the display no longer has frames, we can't expect
1446      to get many more selection requests from it, so don't
1447      bother trying to queue them.  */
1448   if (!NILP (frame))
1449     {
1450       x_start_queuing_selection_requests ();
1451 
1452       record_unwind_protect (queue_selection_requests_unwind,
1453                              Qnil);
1454     }
1455   UNBLOCK_INPUT;
1456 
1457   /* This allows quits.  Also, don't wait forever.  */
1458   secs = x_selection_timeout / 1000;
1459   usecs = (x_selection_timeout % 1000) * 1000;
1460   TRACE1 ("  Start waiting %d secs for SelectionNotify", secs);
1461   wait_reading_process_output (secs, usecs, 0, 0,
1462                                reading_selection_reply, NULL, 0);
1463   TRACE1 ("  Got event = %d", !NILP (XCAR (reading_selection_reply)));
1464 
1465   BLOCK_INPUT;
1466   if (x_had_errors_p (display))
1467     error ("Cannot get selection");
1468   /* This calls x_uncatch_errors.  */
1469   unbind_to (count, Qnil);
1470   UNBLOCK_INPUT;
1471 
1472   if (NILP (XCAR (reading_selection_reply)))
1473     error ("Timed out waiting for reply from selection owner");
1474   if (EQ (XCAR (reading_selection_reply), Qlambda))
1475     return Qnil;
1476 
1477   /* Otherwise, the selection is waiting for us on the requested property.  */
1478   return
1479     x_get_window_property_as_lisp_data (display, requestor_window,
1480                                         target_property, target_type,
1481                                         selection_atom);
1482 }
1483 
1484 /* Subroutines of x_get_window_property_as_lisp_data */
1485 
1486 /* Use xfree, not XFree, to free the data obtained with this function.  */
1487 
1488 static void
1489 x_get_window_property (display, window, property, data_ret, bytes_ret,
1490                        actual_type_ret, actual_format_ret, actual_size_ret,
1491                        delete_p)
1492      Display *display;
1493      Window window;
1494      Atom property;
1495      unsigned char **data_ret;
1496      int *bytes_ret;
1497      Atom *actual_type_ret;
1498      int *actual_format_ret;
1499      unsigned long *actual_size_ret;
1500      int delete_p;
1501 {
1502   int total_size;
1503   unsigned long bytes_remaining;
1504   int offset = 0;
1505   unsigned char *tmp_data = 0;
1506   int result;
1507   int buffer_size = SELECTION_QUANTUM (display);
1508 
1509   if (buffer_size > MAX_SELECTION_QUANTUM)
1510     buffer_size = MAX_SELECTION_QUANTUM;
1511 
1512   BLOCK_INPUT;
1513 
1514   /* First probe the thing to find out how big it is.  */
1515   result = XGetWindowProperty (display, window, property,
1516                                0L, 0L, False, AnyPropertyType,
1517                                actual_type_ret, actual_format_ret,
1518                                actual_size_ret,
1519                                &bytes_remaining, &tmp_data);
1520   if (result != Success)
1521     {
1522       UNBLOCK_INPUT;
1523       *data_ret = 0;
1524       *bytes_ret = 0;
1525       return;
1526     }
1527 
1528   /* This was allocated by Xlib, so use XFree.  */
1529   XFree ((char *) tmp_data);
1530 
1531   if (*actual_type_ret == None || *actual_format_ret == 0)
1532     {
1533       UNBLOCK_INPUT;
1534       return;
1535     }
1536 
1537   total_size = bytes_remaining + 1;
1538   *data_ret = (unsigned char *) xmalloc (total_size);
1539 
1540   /* Now read, until we've gotten it all.  */
1541   while (bytes_remaining)
1542     {
1543 #ifdef TRACE_SELECTION
1544       int last = bytes_remaining;
1545 #endif
1546       result
1547         = XGetWindowProperty (display, window, property,
1548                               (long)offset/4, (long)buffer_size/4,
1549                               False,
1550                               AnyPropertyType,
1551                               actual_type_ret, actual_format_ret,
1552                               actual_size_ret, &bytes_remaining, &tmp_data);
1553 
1554       TRACE2 ("Read %ld bytes from property %s",
1555               last - bytes_remaining,
1556               XGetAtomName (display, property));
1557 
1558       /* If this doesn't return Success at this point, it means that
1559          some clod deleted the selection while we were in the midst of
1560          reading it.  Deal with that, I guess.... */
1561       if (result != Success)
1562         break;
1563 
1564       /* The man page for XGetWindowProperty says:
1565          "If the returned format is 32, the returned data is represented
1566           as a long array and should be cast to that type to obtain the
1567           elements."
1568          This applies even if long is more than 32 bits, the X library
1569          converts from 32 bit elements received from the X server to long
1570          and passes the long array to us.  Thus, for that case bcopy can not
1571          be used.  We convert to a 32 bit type here, because so much code
1572          assume on that.
1573 
1574          The bytes and offsets passed to XGetWindowProperty refers to the
1575          property and those are indeed in 32 bit quantities if format is 32.  */
1576 
1577       if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1578         {
1579           unsigned long i;
1580           int  *idata = (int *) ((*data_ret) + offset);
1581           long *ldata = (long *) tmp_data;
1582 
1583           for (i = 0; i < *actual_size_ret; ++i)
1584             {
1585               idata[i]= (int) ldata[i];
1586               offset += 4;
1587             }
1588         }
1589       else
1590         {
1591           *actual_size_ret *= *actual_format_ret / 8;
1592           bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1593           offset += *actual_size_ret;
1594         }
1595 
1596       /* This was allocated by Xlib, so use XFree.  */
1597       XFree ((char *) tmp_data);
1598     }
1599 
1600   XFlush (display);
1601   UNBLOCK_INPUT;
1602   *bytes_ret = offset;
1603 }
1604 
1605 /* Use xfree, not XFree, to free the data obtained with this function.  */
1606 
1607 static void
1608 receive_incremental_selection (display, window, property, target_type,
1609                                min_size_bytes, data_ret, size_bytes_ret,
1610                                type_ret, format_ret, size_ret)
1611      Display *display;
1612      Window window;
1613      Atom property;
1614      Lisp_Object target_type; /* for error messages only */
1615      unsigned int min_size_bytes;
1616      unsigned char **data_ret;
1617      int *size_bytes_ret;
1618      Atom *type_ret;
1619      unsigned long *size_ret;
1620      int *format_ret;
1621 {
1622   int offset = 0;
1623   struct prop_location *wait_object;
1624   *size_bytes_ret = min_size_bytes;
1625   *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1626 
1627   TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1628 
1629   /* At this point, we have read an INCR property.
1630      Delete the property to ack it.
1631      (But first, prepare to receive the next event in this handshake.)
1632 
1633      Now, we must loop, waiting for the sending window to put a value on
1634      that property, then reading the property, then deleting it to ack.
1635      We are done when the sender places a property of length 0.
1636    */
1637   BLOCK_INPUT;
1638   XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1639   TRACE1 ("  Delete property %s",
1640           SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1641   XDeleteProperty (display, window, property);
1642   TRACE1 ("  Expect new value of property %s",
1643           SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1644   wait_object = expect_property_change (display, window, property,
1645                                         PropertyNewValue);
1646   XFlush (display);
1647   UNBLOCK_INPUT;
1648 
1649   while (1)
1650     {
1651       unsigned char *tmp_data;
1652       int tmp_size_bytes;
1653 
1654       TRACE0 ("  Wait for property change");
1655       wait_for_property_change (wait_object);
1656 
1657       /* expect it again immediately, because x_get_window_property may
1658          .. no it won't, I don't get it.
1659          .. Ok, I get it now, the Xt code that implements INCR is broken. */
1660       TRACE0 ("  Get property value");
1661       x_get_window_property (display, window, property,
1662                              &tmp_data, &tmp_size_bytes,
1663                              type_ret, format_ret, size_ret, 1);
1664 
1665       TRACE1 ("  Read increment of %d bytes", tmp_size_bytes);
1666 
1667       if (tmp_size_bytes == 0) /* we're done */
1668         {
1669           TRACE0 ("Done reading incrementally");
1670 
1671           if (! waiting_for_other_props_on_window (display, window))
1672             XSelectInput (display, window, STANDARD_EVENT_SET);
1673           /* Use xfree, not XFree, because x_get_window_property
1674              calls xmalloc itself.  */
1675           xfree (tmp_data);
1676           break;
1677         }
1678 
1679       BLOCK_INPUT;
1680       TRACE1 ("  ACK by deleting property %s",
1681               XGetAtomName (display, property));
1682       XDeleteProperty (display, window, property);
1683       wait_object = expect_property_change (display, window, property,
1684                                             PropertyNewValue);
1685       XFlush (display);
1686       UNBLOCK_INPUT;
1687 
1688       if (*size_bytes_ret < offset + tmp_size_bytes)
1689         {
1690           *size_bytes_ret = offset + tmp_size_bytes;
1691           *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1692         }
1693 
1694       bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1695       offset += tmp_size_bytes;
1696 
1697       /* Use xfree, not XFree, because x_get_window_property
1698          calls xmalloc itself.  */
1699       xfree (tmp_data);
1700     }
1701 }
1702 
1703 
1704 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1705    fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1706    TARGET_TYPE and SELECTION_ATOM are used in error message if this fails.  */
1707 
1708 static Lisp_Object
1709 x_get_window_property_as_lisp_data (display, window, property, target_type,
1710                                     selection_atom)
1711      Display *display;
1712      Window window;
1713      Atom property;
1714      Lisp_Object target_type;   /* for error messages only */
1715      Atom selection_atom;       /* for error messages only */
1716 {
1717   Atom actual_type;
1718   int actual_format;
1719   unsigned long actual_size;
1720   unsigned char *data = 0;
1721   int bytes = 0;
1722   Lisp_Object val;
1723   struct x_display_info *dpyinfo = x_display_info_for_display (display);
1724 
1725   TRACE0 ("Reading selection data");
1726 
1727   x_get_window_property (display, window, property, &data, &bytes,
1728                          &actual_type, &actual_format, &actual_size, 1);
1729   if (! data)
1730     {
1731       int there_is_a_selection_owner;
1732       BLOCK_INPUT;
1733       there_is_a_selection_owner
1734         = XGetSelectionOwner (display, selection_atom);
1735       UNBLOCK_INPUT;
1736       if (there_is_a_selection_owner)
1737         signal_error ("Selection owner couldn't convert",
1738                       actual_type
1739                       ? list2 (target_type,
1740                                x_atom_to_symbol (display, actual_type))
1741                       : target_type);
1742       else
1743         signal_error ("No selection",
1744                       x_atom_to_symbol (display, selection_atom));
1745     }
1746 
1747   if (actual_type == dpyinfo->Xatom_INCR)
1748     {
1749       /* That wasn't really the data, just the beginning.  */
1750 
1751       unsigned int min_size_bytes = * ((unsigned int *) data);
1752       BLOCK_INPUT;
1753       /* Use xfree, not XFree, because x_get_window_property
1754          calls xmalloc itself.  */
1755       xfree ((char *) data);
1756       UNBLOCK_INPUT;
1757       receive_incremental_selection (display, window, property, target_type,
1758                                      min_size_bytes, &data, &bytes,
1759                                      &actual_type, &actual_format,
1760                                      &actual_size);
1761     }
1762 
1763   BLOCK_INPUT;
1764   TRACE1 ("  Delete property %s", XGetAtomName (display, property));
1765   XDeleteProperty (display, window, property);
1766   XFlush (display);
1767   UNBLOCK_INPUT;
1768 
1769   /* It's been read.  Now convert it to a lisp object in some semi-rational
1770      manner.  */
1771   val = selection_data_to_lisp_data (display, data, bytes,
1772                                      actual_type, actual_format);
1773 
1774   /* Use xfree, not XFree, because x_get_window_property
1775      calls xmalloc itself.  */
1776   xfree ((char *) data);
1777   return val;
1778 }
1779 
1780 /* These functions convert from the selection data read from the server into
1781    something that we can use from Lisp, and vice versa.
1782 
1783         Type:   Format: Size:           Lisp Type:
1784         -----   ------- -----           -----------
1785         *       8       *               String
1786         ATOM    32      1               Symbol
1787         ATOM    32      > 1             Vector of Symbols
1788         *       16      1               Integer
1789         *       16      > 1             Vector of Integers
1790         *       32      1               if <=16 bits: Integer
1791                                         if > 16 bits: Cons of top16, bot16
1792         *       32      > 1             Vector of the above
1793 
1794    When converting a Lisp number to C, it is assumed to be of format 16 if
1795    it is an integer, and of format 32 if it is a cons of two integers.
1796 
1797    When converting a vector of numbers from Lisp to C, it is assumed to be
1798    of format 16 if every element in the vector is an integer, and is assumed
1799    to be of format 32 if any element is a cons of two integers.
1800 
1801    When converting an object to C, it may be of the form (SYMBOL . <data>)
1802    where SYMBOL is what we should claim that the type is.  Format and
1803    representation are as above.
1804 
1805    Important: When format is 32, data should contain an array of int,
1806    not an array of long as the X library returns.  This makes a difference
1807    when sizeof(long) != sizeof(int).  */
1808 
1809 
1810 
1811 static Lisp_Object
1812 selection_data_to_lisp_data (display, data, size, type, format)
1813      Display *display;
1814      unsigned char *data;
1815      Atom type;
1816      int size, format;
1817 {
1818   struct x_display_info *dpyinfo = x_display_info_for_display (display);
1819 
1820   if (type == dpyinfo->Xatom_NULL)
1821     return QNULL;
1822 
1823   /* Convert any 8-bit data to a string, for compactness.  */
1824   else if (format == 8)
1825     {
1826       Lisp_Object str, lispy_type;
1827 
1828       str = make_unibyte_string ((char *) data, size);
1829       /* Indicate that this string is from foreign selection by a text
1830          property `foreign-selection' so that the caller of
1831          x-get-selection-internal (usually x-get-selection) can know
1832          that the string must be decode.  */
1833       if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1834         lispy_type = QCOMPOUND_TEXT;
1835       else if (type == dpyinfo->Xatom_UTF8_STRING)
1836         lispy_type = QUTF8_STRING;
1837       else
1838         lispy_type = QSTRING;
1839       Fput_text_property (make_number (0), make_number (size),
1840                           Qforeign_selection, lispy_type, str);
1841       return str;
1842     }
1843   /* Convert a single atom to a Lisp_Symbol.  Convert a set of atoms to
1844      a vector of symbols.
1845    */
1846   else if (type == XA_ATOM)
1847     {
1848       int i;
1849       /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1850          But the callers of these function has made sure the data for
1851          format == 32 is an array of int.  Thus, use int instead
1852          of Atom.  */
1853       int *idata = (int *) data;
1854 
1855       if (size == sizeof (int))
1856         return x_atom_to_symbol (display, (Atom) idata[0]);
1857       else
1858         {
1859           Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
1860                                         make_number (0));
1861           for (i = 0; i < size / sizeof (int); i++)
1862             Faset (v, make_number (i),
1863                    x_atom_to_symbol (display, (Atom) idata[i]));
1864           return v;
1865         }
1866     }
1867 
1868   /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1869      If the number is 32 bits and won't fit in a Lisp_Int,
1870      convert it to a cons of integers, 16 bits in each half.
1871    */
1872   else if (format == 32 && size == sizeof (int))
1873     return long_to_cons (((unsigned int *) data) [0]);
1874   else if (format == 16 && size == sizeof (short))
1875     return make_number ((int) (((unsigned short *) data) [0]));
1876 
1877   /* Convert any other kind of data to a vector of numbers, represented
1878      as above (as an integer, or a cons of two 16 bit integers.)
1879    */
1880   else if (format == 16)
1881     {
1882       int i;
1883       Lisp_Object v;
1884       v = Fmake_vector (make_number (size / 2), make_number (0));
1885       for (i = 0; i < size / 2; i++)
1886         {
1887           int j = (int) ((unsigned short *) data) [i];
1888           Faset (v, make_number (i), make_number (j));
1889         }
1890       return v;
1891     }
1892   else
1893     {
1894       int i;
1895       Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1896       for (i = 0; i < size / 4; i++)
1897         {
1898           unsigned int j = ((unsigned int *) data) [i];
1899           Faset (v, make_number (i), long_to_cons (j));
1900         }
1901       return v;
1902     }
1903 }
1904 
1905 
1906 /* Use xfree, not XFree, to free the data obtained with this function.  */
1907 
1908 static void
1909 lisp_data_to_selection_data (display, obj,
1910                              data_ret, type_ret, size_ret,
1911                              format_ret, nofree_ret)
1912      Display *display;
1913      Lisp_Object obj;
1914      unsigned char **data_ret;
1915      Atom *type_ret;
1916      unsigned int *size_ret;
1917      int *format_ret;
1918      int *nofree_ret;
1919 {
1920   Lisp_Object type = Qnil;
1921   struct x_display_info *dpyinfo = x_display_info_for_display (display);
1922 
1923   *nofree_ret = 0;
1924 
1925   if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1926     {
1927       type = XCAR (obj);
1928       obj = XCDR (obj);
1929       if (CONSP (obj) && NILP (XCDR (obj)))
1930         obj = XCAR (obj);
1931     }
1932 
1933   if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1934     {                           /* This is not the same as declining */
1935       *format_ret = 32;
1936       *size_ret = 0;
1937       *data_ret = 0;
1938       type = QNULL;
1939     }
1940   else if (STRINGP (obj))
1941     {
1942       if (SCHARS (obj) < SBYTES (obj))
1943         /* OBJ is a multibyte string containing a non-ASCII char.  */
1944         signal_error ("Non-ASCII string must be encoded in advance", obj);
1945       if (NILP (type))
1946         type = QSTRING;
1947       *format_ret = 8;
1948       *size_ret = SBYTES (obj);
1949       *data_ret = SDATA (obj);
1950       *nofree_ret = 1;
1951     }
1952   else if (SYMBOLP (obj))
1953     {
1954       *format_ret = 32;
1955       *size_ret = 1;
1956       *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1957       (*data_ret) [sizeof (Atom)] = 0;
1958       (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1959       if (NILP (type)) type = QATOM;
1960     }
1961   else if (INTEGERP (obj)
1962            && XINT (obj) < 0xFFFF
1963            && XINT (obj) > -0xFFFF)
1964     {
1965       *format_ret = 16;
1966       *size_ret = 1;
1967       *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1968       (*data_ret) [sizeof (short)] = 0;
1969       (*(short **) data_ret) [0] = (short) XINT (obj);
1970       if (NILP (type)) type = QINTEGER;
1971     }
1972   else if (INTEGERP (obj)
1973            || (CONSP (obj) && INTEGERP (XCAR (obj))
1974                && (INTEGERP (XCDR (obj))
1975                    || (CONSP (XCDR (obj))
1976                        && INTEGERP (XCAR (XCDR (obj)))))))
1977     {
1978       *format_ret = 32;
1979       *size_ret = 1;
1980       *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1981       (*data_ret) [sizeof (long)] = 0;
1982       (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1983       if (NILP (type)) type = QINTEGER;
1984     }
1985   else if (VECTORP (obj))
1986     {
1987       /* Lisp_Vectors may represent a set of ATOMs;
1988          a set of 16 or 32 bit INTEGERs;
1989          or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1990        */
1991       int i;
1992 
1993       if (SYMBOLP (XVECTOR (obj)->contents [0]))
1994         /* This vector is an ATOM set */
1995         {
1996           if (NILP (type)) type = QATOM;
1997           *size_ret = XVECTOR (obj)->size;
1998           *format_ret = 32;
1999           *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
2000           for (i = 0; i < *size_ret; i++)
2001             if (SYMBOLP (XVECTOR (obj)->contents [i]))
2002               (*(Atom **) data_ret) [i]
2003                 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
2004             else
2005               signal_error ("All elements of selection vector must have same type", obj);
2006         }
2007 #if 0 /* #### MULTIPLE doesn't work yet */
2008       else if (VECTORP (XVECTOR (obj)->contents [0]))
2009         /* This vector is an ATOM_PAIR set */
2010         {
2011           if (NILP (type)) type = QATOM_PAIR;
2012           *size_ret = XVECTOR (obj)->size;
2013           *format_ret = 32;
2014           *data_ret = (unsigned char *)
2015             xmalloc ((*size_ret) * sizeof (Atom) * 2);
2016           for (i = 0; i < *size_ret; i++)
2017             if (VECTORP (XVECTOR (obj)->contents [i]))
2018               {
2019                 Lisp_Object pair = XVECTOR (obj)->contents [i];
2020                 if (XVECTOR (pair)->size != 2)
2021                   signal_error (
2022         "Elements of the vector must be vectors of exactly two elements",
2023                                 pair);
2024 
2025                 (*(Atom **) data_ret) [i * 2]
2026                   = symbol_to_x_atom (dpyinfo, display,
2027                                       XVECTOR (pair)->contents [0]);
2028                 (*(Atom **) data_ret) [(i * 2) + 1]
2029                   = symbol_to_x_atom (dpyinfo, display,
2030                                       XVECTOR (pair)->contents [1]);
2031               }
2032             else
2033               signal_error ("All elements of the vector must be of the same type",
2034                             obj);
2035 
2036         }
2037 #endif
2038       else
2039         /* This vector is an INTEGER set, or something like it */
2040         {
2041           int data_size = 2;
2042           *size_ret = XVECTOR (obj)->size;
2043           if (NILP (type)) type = QINTEGER;
2044           *format_ret = 16;
2045           for (i = 0; i < *size_ret; i++)
2046             if (CONSP (XVECTOR (obj)->contents [i]))
2047               *format_ret = 32;
2048             else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2049               signal_error (/* Qselection_error */
2050     "Elements of selection vector must be integers or conses of integers",
2051                             obj);
2052 
2053           /* Use sizeof(long) even if it is more than 32 bits.  See comment
2054              in x_get_window_property and x_fill_property_data.  */
2055 
2056           if (*format_ret == 32) data_size = sizeof(long);
2057           *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
2058           for (i = 0; i < *size_ret; i++)
2059             if (*format_ret == 32)
2060               (*((unsigned long **) data_ret)) [i]
2061                 = cons_to_long (XVECTOR (obj)->contents [i]);
2062             else
2063               (*((unsigned short **) data_ret)) [i]
2064                 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2065         }
2066     }
2067   else
2068     signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
2069 
2070   *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2071 }
2072 
2073 static Lisp_Object
2074 clean_local_selection_data (obj)
2075      Lisp_Object obj;
2076 {
2077   if (CONSP (obj)
2078       && INTEGERP (XCAR (obj))
2079       && CONSP (XCDR (obj))
2080       && INTEGERP (XCAR (XCDR (obj)))
2081       && NILP (XCDR (XCDR (obj))))
2082     obj = Fcons (XCAR (obj), XCDR (obj));
2083 
2084   if (CONSP (obj)
2085       && INTEGERP (XCAR (obj))
2086       && INTEGERP (XCDR (obj)))
2087     {
2088       if (XINT (XCAR (obj)) == 0)
2089         return XCDR (obj);
2090       if (XINT (XCAR (obj)) == -1)
2091         return make_number (- XINT (XCDR (obj)));
2092     }
2093   if (VECTORP (obj))
2094     {
2095       int i;
2096       int size = XVECTOR (obj)->size;
2097       Lisp_Object copy;
2098       if (size == 1)
2099         return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2100       copy = Fmake_vector (make_number (size), Qnil);
2101       for (i = 0; i < size; i++)
2102         XVECTOR (copy)->contents [i]
2103           = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2104       return copy;
2105     }
2106   return obj;
2107 }
2108 
2109 /* Called from XTread_socket to handle SelectionNotify events.
2110    If it's the selection we are waiting for, stop waiting
2111    by setting the car of reading_selection_reply to non-nil.
2112    We store t there if the reply is successful, lambda if not.  */
2113 
2114 void
2115 x_handle_selection_notify (event)
2116      XSelectionEvent *event;
2117 {
2118   if (event->requestor != reading_selection_window)
2119     return;
2120   if (event->selection != reading_which_selection)
2121     return;
2122 
2123   TRACE0 ("Received SelectionNotify");
2124   XSETCAR (reading_selection_reply,
2125            (event->property != 0 ? Qt : Qlambda));
2126 }
2127 
2128 
2129 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2130        Sx_own_selection_internal, 2, 2, 0,
2131        doc: /* Assert an X selection of the given TYPE with the given VALUE.
2132 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2133 \(Those are literal upper-case symbol names, since that's what X expects.)
2134 VALUE is typically a string, or a cons of two markers, but may be
2135 anything that the functions on `selection-converter-alist' know about.  */)
2136      (selection_name, selection_value)
2137      Lisp_Object selection_name, selection_value;
2138 {
2139   check_x ();
2140   CHECK_SYMBOL (selection_name);
2141   if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
2142   x_own_selection (selection_name, selection_value);
2143   return selection_value;
2144 }
2145 
2146 
2147 /* Request the selection value from the owner.  If we are the owner,
2148    simply return our selection value.  If we are not the owner, this
2149    will block until all of the data has arrived.  */
2150 
2151 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2152        Sx_get_selection_internal, 2, 3, 0,
2153        doc: /* Return text selected from some X window.
2154 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2155 \(Those are literal upper-case symbol names, since that's what X expects.)
2156 TYPE is the type of data desired, typically `STRING'.
2157 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2158 selections.  If omitted, defaults to the time for the last event.  */)
2159   (selection_symbol, target_type, time_stamp)
2160      Lisp_Object selection_symbol, target_type, time_stamp;
2161 {
2162   Lisp_Object val = Qnil;
2163   struct gcpro gcpro1, gcpro2;
2164   GCPRO2 (target_type, val); /* we store newly consed data into these */
2165   check_x ();
2166   CHECK_SYMBOL (selection_symbol);
2167 
2168 #if 0 /* #### MULTIPLE doesn't work yet */
2169   if (CONSP (target_type)
2170       && XCAR (target_type) == QMULTIPLE)
2171     {
2172       CHECK_VECTOR (XCDR (target_type));
2173       /* So we don't destructively modify this...  */
2174       target_type = copy_multiple_data (target_type);
2175     }
2176   else
2177 #endif
2178     CHECK_SYMBOL (target_type);
2179 
2180   val = x_get_local_selection (selection_symbol, target_type, 1);
2181 
2182   if (NILP (val))
2183     {
2184       val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2185       goto DONE;
2186     }
2187 
2188   if (CONSP (val)
2189       && SYMBOLP (XCAR (val)))
2190     {
2191       val = XCDR (val);
2192       if (CONSP (val) && NILP (XCDR (val)))
2193         val = XCAR (val);
2194     }
2195   val = clean_local_selection_data (val);
2196  DONE:
2197   UNGCPRO;
2198   return val;
2199 }
2200 
2201 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2202        Sx_disown_selection_internal, 1, 2, 0,
2203        doc: /* If we own the selection SELECTION, disown it.
2204 Disowning it means there is no such selection.  */)
2205      (selection, time)
2206      Lisp_Object selection;
2207      Lisp_Object time;
2208 {
2209   Time timestamp;
2210   Atom selection_atom;
2211   union {
2212     struct selection_input_event sie;
2213     struct input_event ie;
2214   } event;
2215   Display *display;
2216   struct x_display_info *dpyinfo;
2217   struct frame *sf = SELECTED_FRAME ();
2218 
2219   check_x ();
2220   if (! FRAME_X_P (sf))
2221     return Qnil;
2222 
2223   display = FRAME_X_DISPLAY (sf);
2224   dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2225   CHECK_SYMBOL (selection);
2226   if (NILP (time))
2227     timestamp = last_event_timestamp;
2228   else
2229     timestamp = cons_to_long (time);
2230 
2231   if (NILP (assq_no_quit (selection, Vselection_alist)))
2232     return Qnil;  /* Don't disown the selection when we're not the owner.  */
2233 
2234   selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2235 
2236   BLOCK_INPUT;
2237   XSetSelectionOwner (display, selection_atom, None, timestamp);
2238   UNBLOCK_INPUT;
2239 
2240   /* It doesn't seem to be guaranteed that a SelectionClear event will be
2241      generated for a window which owns the selection when that window sets
2242      the selection owner to None.  The NCD server does, the MIT Sun4 server
2243      doesn't.  So we synthesize one; this means we might get two, but
2244      that's ok, because the second one won't have any effect.  */
2245   SELECTION_EVENT_DISPLAY (&event.sie) = display;
2246   SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2247   SELECTION_EVENT_TIME (&event.sie) = timestamp;
2248   x_handle_selection_clear (&event.ie);
2249 
2250   return Qt;
2251 }
2252 
2253 /* Get rid of all the selections in buffer BUFFER.
2254    This is used when we kill a buffer.  */
2255 
2256 void
2257 x_disown_buffer_selections (buffer)
2258      Lisp_Object buffer;
2259 {
2260   Lisp_Object tail;
2261   struct buffer *buf = XBUFFER (buffer);
2262 
2263   for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2264     {
2265       Lisp_Object elt, value;
2266       elt = XCAR (tail);
2267       value = XCDR (elt);
2268       if (CONSP (value) && MARKERP (XCAR (value))
2269           && XMARKER (XCAR (value))->buffer == buf)
2270         Fx_disown_selection_internal (XCAR (elt), Qnil);
2271     }
2272 }
2273 
2274 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2275        0, 1, 0,
2276        doc: /* Whether the current Emacs process owns the given X Selection.
2277 The arg should be the name of the selection in question, typically one of
2278 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2279 \(Those are literal upper-case symbol names, since that's what X expects.)
2280 For convenience, the symbol nil is the same as `PRIMARY',
2281 and t is the same as `SECONDARY'.  */)
2282      (selection)
2283      Lisp_Object selection;
2284 {
2285   check_x ();
2286   CHECK_SYMBOL (selection);
2287   if (EQ (selection, Qnil)) selection = QPRIMARY;
2288   if (EQ (selection, Qt)) selection = QSECONDARY;
2289 
2290   if (NILP (Fassq (selection, Vselection_alist)))
2291     return Qnil;
2292   return Qt;
2293 }
2294 
2295 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2296        0, 1, 0,
2297        doc: /* Whether there is an owner for the given X Selection.
2298 The arg should be the name of the selection in question, typically one of
2299 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2300 \(Those are literal upper-case symbol names, since that's what X expects.)
2301 For convenience, the symbol nil is the same as `PRIMARY',
2302 and t is the same as `SECONDARY'.  */)
2303      (selection)
2304      Lisp_Object selection;
2305 {
2306   Window owner;
2307   Atom atom;
2308   Display *dpy;
2309   struct frame *sf = SELECTED_FRAME ();
2310 
2311   /* It should be safe to call this before we have an X frame.  */
2312   if (! FRAME_X_P (sf))
2313     return Qnil;
2314 
2315   dpy = FRAME_X_DISPLAY (sf);
2316   CHECK_SYMBOL (selection);
2317   if (!NILP (Fx_selection_owner_p (selection)))
2318     return Qt;
2319   if (EQ (selection, Qnil)) selection = QPRIMARY;
2320   if (EQ (selection, Qt)) selection = QSECONDARY;
2321   atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2322   if (atom == 0)
2323     return Qnil;
2324   BLOCK_INPUT;
2325   owner = XGetSelectionOwner (dpy, atom);
2326   UNBLOCK_INPUT;
2327   return (owner ? Qt : Qnil);
2328 }
2329 
2330 
2331 #ifdef CUT_BUFFER_SUPPORT
2332 
2333 /* Ensure that all 8 cut buffers exist.  ICCCM says we gotta...  */
2334 static void
2335 initialize_cut_buffers (display, window)
2336      Display *display;
2337      Window window;
2338 {
2339   unsigned char *data = (unsigned char *) "";
2340   BLOCK_INPUT;
2341 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2342                                     PropModeAppend, data, 0)
2343   FROB (XA_CUT_BUFFER0);
2344   FROB (XA_CUT_BUFFER1);
2345   FROB (XA_CUT_BUFFER2);
2346   FROB (XA_CUT_BUFFER3);
2347   FROB (XA_CUT_BUFFER4);
2348   FROB (XA_CUT_BUFFER5);
2349   FROB (XA_CUT_BUFFER6);
2350   FROB (XA_CUT_BUFFER7);
2351 #undef FROB
2352   UNBLOCK_INPUT;
2353 }
2354 
2355 
2356 #define CHECK_CUT_BUFFER(symbol)                                        \
2357   do { CHECK_SYMBOL ((symbol));                                 \
2358     if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1)      \
2359         && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3)   \
2360         && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5)   \
2361         && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))  \
2362       signal_error ("Doesn't name a cut buffer", (symbol));             \
2363   } while (0)
2364 
2365 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2366        Sx_get_cut_buffer_internal, 1, 1, 0,
2367        doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0).  */)
2368      (buffer)
2369      Lisp_Object buffer;
2370 {
2371   Window window;
2372   Atom buffer_atom;
2373   unsigned char *data = NULL;
2374   int bytes;
2375   Atom type;
2376   int format;
2377   unsigned long size;
2378   Lisp_Object ret;
2379   Display *display;
2380   struct x_display_info *dpyinfo;
2381   struct frame *sf = SELECTED_FRAME ();
2382 
2383   check_x ();
2384 
2385   if (! FRAME_X_P (sf))
2386     return Qnil;
2387 
2388   display = FRAME_X_DISPLAY (sf);
2389   dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2390   window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2391   CHECK_CUT_BUFFER (buffer);
2392   buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2393 
2394   x_get_window_property (display, window, buffer_atom, &data, &bytes,
2395                          &type, &format, &size, 0);
2396 
2397   if (!data || !format)
2398     {
2399       xfree (data);
2400       return Qnil;
2401     }
2402 
2403   if (format != 8 || type != XA_STRING)
2404     signal_error ("Cut buffer doesn't contain 8-bit data",
2405                   list2 (x_atom_to_symbol (display, type),
2406                          make_number (format)));
2407 
2408   ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
2409   /* Use xfree, not XFree, because x_get_window_property
2410      calls xmalloc itself.  */
2411   xfree (data);
2412   return ret;
2413 }
2414 
2415 
2416 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2417        Sx_store_cut_buffer_internal, 2, 2, 0,
2418        doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0).  */)
2419      (buffer, string)
2420      Lisp_Object buffer, string;
2421 {
2422   Window window;
2423   Atom buffer_atom;
2424   unsigned char *data;
2425   int bytes;
2426   int bytes_remaining;
2427   int max_bytes;
2428   Display *display;
2429   struct frame *sf = SELECTED_FRAME ();
2430 
2431   check_x ();
2432 
2433   if (! FRAME_X_P (sf))
2434     return Qnil;
2435 
2436   display = FRAME_X_DISPLAY (sf);
2437   window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2438 
2439   max_bytes = SELECTION_QUANTUM (display);
2440   if (max_bytes > MAX_SELECTION_QUANTUM)
2441     max_bytes = MAX_SELECTION_QUANTUM;
2442 
2443   CHECK_CUT_BUFFER (buffer);
2444   CHECK_STRING (string);
2445   buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2446                                   display, buffer);
2447   data = (unsigned char *) SDATA (string);
2448   bytes = SBYTES (string);
2449   bytes_remaining = bytes;
2450 
2451   if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2452     {
2453       initialize_cut_buffers (display, window);
2454       FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2455     }
2456 
2457   BLOCK_INPUT;
2458 
2459   /* Don't mess up with an empty value.  */
2460   if (!bytes_remaining)
2461     XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2462                      PropModeReplace, data, 0);
2463 
2464   while (bytes_remaining)
2465     {
2466       int chunk = (bytes_remaining < max_bytes
2467                    ? bytes_remaining : max_bytes);
2468       XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2469                        (bytes_remaining == bytes
2470                         ? PropModeReplace
2471                         : PropModeAppend),
2472                        data, chunk);
2473       data += chunk;
2474       bytes_remaining -= chunk;
2475     }
2476   UNBLOCK_INPUT;
2477   return string;
2478 }
2479 
2480 
2481 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2482        Sx_rotate_cut_buffers_internal, 1, 1, 0,
2483        doc: /* Rotate the values of the cut buffers by N steps.
2484 Positive N means shift the values forward, negative means backward.  */)
2485      (n)
2486      Lisp_Object n;
2487 {
2488   Window window;
2489   Atom props[8];
2490   Display *display;
2491   struct frame *sf = SELECTED_FRAME ();
2492   
2493   check_x ();
2494 
2495   if (! FRAME_X_P (sf))
2496     return Qnil;
2497 
2498   display = FRAME_X_DISPLAY (sf);
2499   window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2500   CHECK_NUMBER (n);
2501   if (XINT (n) == 0)
2502     return n;
2503   if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2504     {
2505       initialize_cut_buffers (display, window);
2506       FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2507     }
2508 
2509   props[0] = XA_CUT_BUFFER0;
2510   props[1] = XA_CUT_BUFFER1;
2511   props[2] = XA_CUT_BUFFER2;
2512   props[3] = XA_CUT_BUFFER3;
2513   props[4] = XA_CUT_BUFFER4;
2514   props[5] = XA_CUT_BUFFER5;
2515   props[6] = XA_CUT_BUFFER6;
2516   props[7] = XA_CUT_BUFFER7;
2517   BLOCK_INPUT;
2518   XRotateWindowProperties (display, window, props, 8, XINT (n));
2519   UNBLOCK_INPUT;
2520   return n;
2521 }
2522 
2523 #endif
2524 
2525 /***********************************************************************
2526                       Drag and drop support
2527 ***********************************************************************/
2528 /* Check that lisp values are of correct type for x_fill_property_data.
2529    That is, number, string or a cons with two numbers (low and high 16
2530    bit parts of a 32 bit number).  */
2531 
2532 int
2533 x_check_property_data (data)
2534      Lisp_Object data;
2535 {
2536   Lisp_Object iter;
2537   int size = 0;
2538 
2539   for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2540     {
2541       Lisp_Object o = XCAR (iter);
2542 
2543       if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2544         size = -1;
2545       else if (CONSP (o) &&
2546                (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2547         size = -1;
2548     }
2549 
2550   return size;
2551 }
2552 
2553 /* Convert lisp values to a C array.  Values may be a number, a string
2554    which is taken as an X atom name and converted to the atom value, or
2555    a cons containing the two 16 bit parts of a 32 bit number.
2556 
2557    DPY is the display use to look up X atoms.
2558    DATA is a Lisp list of values to be converted.
2559    RET is the C array that contains the converted values.  It is assumed
2560    it is big enough to hold all values.
2561    FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2562    be stored in RET.  Note that long is used for 32 even if long is more
2563    than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2564    XClientMessageEvent).  */
2565 
2566 void
2567 x_fill_property_data (dpy, data, ret, format)
2568      Display *dpy;
2569      Lisp_Object data;
2570      void *ret;
2571      int format;
2572 {
2573   long val;
2574   long  *d32 = (long  *) ret;
2575   short *d16 = (short *) ret;
2576   char  *d08 = (char  *) ret;
2577   Lisp_Object iter;
2578 
2579   for (iter = data; CONSP (iter); iter = XCDR (iter))
2580     {
2581       Lisp_Object o = XCAR (iter);
2582 
2583       if (INTEGERP (o))
2584         val = (long) XFASTINT (o);
2585       else if (FLOATP (o))
2586         val = (long) XFLOAT_DATA (o);
2587       else if (CONSP (o))
2588         val = (long) cons_to_long (o);
2589       else if (STRINGP (o))
2590         {
2591           BLOCK_INPUT;
2592           val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
2593           UNBLOCK_INPUT;
2594         }
2595       else
2596         error ("Wrong type, must be string, number or cons");
2597 
2598       if (format == 8)
2599         *d08++ = (char) val;
2600       else if (format == 16)
2601         *d16++ = (short) val;
2602       else
2603         *d32++ = val;
2604     }
2605 }
2606 
2607 /* Convert an array of C values to a Lisp list.
2608    F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2609    DATA is a C array of values to be converted.
2610    TYPE is the type of the data.  Only XA_ATOM is special, it converts
2611    each number in DATA to its corresponfing X atom as a symbol.
2612    FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2613    be stored in RET.
2614    SIZE is the number of elements in DATA.
2615 
2616    Important: When format is 32, data should contain an array of int,
2617    not an array of long as the X library returns.  This makes a difference
2618    when sizeof(long) != sizeof(int).
2619 
2620    Also see comment for selection_data_to_lisp_data above.  */
2621 
2622 Lisp_Object
2623 x_property_data_to_lisp (f, data, type, format, size)
2624      struct frame *f;
2625      unsigned char *data;
2626      Atom type;
2627      int format;
2628      unsigned long size;
2629 {
2630   return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2631                                       data, size*format/8, type, format);
2632 }
2633 
2634 /* Get the mouse position in frame relative coordinates.  */
2635 
2636 static void
2637 mouse_position_for_drop (f, x, y)
2638      FRAME_PTR f;
2639      int *x;
2640      int *y;
2641 {
2642   Window root, dummy_window;
2643   int dummy;
2644 
2645   BLOCK_INPUT;
2646 
2647   XQueryPointer (FRAME_X_DISPLAY (f),
2648                  DefaultRootWindow (FRAME_X_DISPLAY (f)),
2649 
2650                  /* The root window which contains the pointer.  */
2651                  &root,
2652 
2653                  /* Window pointer is on, not used  */
2654                  &dummy_window,
2655 
2656                  /* The position on that root window.  */
2657                  x, y,
2658 
2659                  /* x/y in dummy_window coordinates, not used.  */
2660                  &dummy, &dummy,
2661 
2662                  /* Modifier keys and pointer buttons, about which
2663                     we don't care.  */
2664                  (unsigned int *) &dummy);
2665 
2666 
2667   /* Absolute to relative.  */
2668   *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2669   *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2670 
2671   UNBLOCK_INPUT;
2672 }
2673 
2674 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2675        Sx_get_atom_name, 1, 2, 0,
2676        doc: /* Return the X atom name for VALUE as a string.
2677 VALUE may be a number or a cons where the car is the upper 16 bits and
2678 the cdr is the lower 16 bits of a 32 bit value.
2679 Use the display for FRAME or the current frame if FRAME is not given or nil.
2680 
2681 If the value is 0 or the atom is not known, return the empty string.  */)
2682   (value, frame)
2683      Lisp_Object value, frame;
2684 {
2685   struct frame *f = check_x_frame (frame);
2686   char *name = 0;
2687   Lisp_Object ret = Qnil;
2688   Display *dpy = FRAME_X_DISPLAY (f);
2689   Atom atom;
2690   int had_errors;
2691 
2692   if (INTEGERP (value))
2693     atom = (Atom) XUINT (value);
2694   else if (FLOATP (value))
2695     atom = (Atom) XFLOAT_DATA (value);
2696   else if (CONSP (value))
2697     atom = (Atom) cons_to_long (value);
2698   else
2699     error ("Wrong type, value must be number or cons");
2700 
2701   BLOCK_INPUT;
2702   x_catch_errors (dpy);
2703   name = atom ? XGetAtomName (dpy, atom) : "";
2704   had_errors = x_had_errors_p (dpy);
2705   x_uncatch_errors ();
2706 
2707   if (!had_errors)
2708     ret = make_string (name, strlen (name));
2709 
2710   if (atom && name) XFree (name);
2711   if (NILP (ret)) ret = empty_unibyte_string;
2712 
2713   UNBLOCK_INPUT;
2714 
2715   return ret;
2716 }
2717 
2718 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
2719        Sx_register_dnd_atom, 1, 2, 0,
2720        doc: /* Request that dnd events are made for ClientMessages with ATOM.
2721 ATOM can be a symbol or a string.  The ATOM is interned on the display that
2722 FRAME is on.  If FRAME is nil, the selected frame is used.  */)
2723     (atom, frame)
2724     Lisp_Object atom, frame;
2725 {
2726   Atom x_atom;
2727   struct frame *f = check_x_frame (frame);
2728   size_t i;
2729   struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2730 
2731 
2732   if (SYMBOLP (atom))
2733     x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom);
2734   else if (STRINGP (atom))
2735     {
2736       BLOCK_INPUT;
2737       x_atom = XInternAtom (FRAME_X_DISPLAY (f), (char *) SDATA (atom), False);
2738       UNBLOCK_INPUT;
2739     }
2740   else
2741     error ("ATOM must be a symbol or a string");
2742 
2743   for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2744     if (dpyinfo->x_dnd_atoms[i] == x_atom)
2745       return Qnil;
2746 
2747   if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
2748     {
2749       dpyinfo->x_dnd_atoms_size *= 2;
2750       dpyinfo->x_dnd_atoms = xrealloc (dpyinfo->x_dnd_atoms,
2751                                        sizeof (*dpyinfo->x_dnd_atoms)
2752                                        * dpyinfo->x_dnd_atoms_size);
2753     }
2754 
2755   dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
2756   return Qnil;
2757 }
2758 
2759 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.  */
2760 
2761 int
2762 x_handle_dnd_message (f, event, dpyinfo, bufp)
2763      struct frame *f;
2764      XClientMessageEvent *event;
2765      struct x_display_info *dpyinfo;
2766      struct input_event *bufp;
2767 {
2768   Lisp_Object vec;
2769   Lisp_Object frame;
2770   /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2771   unsigned long size = 160/event->format;
2772   int x, y;
2773   unsigned char *data = (unsigned char *) event->data.b;
2774   int idata[5];
2775   size_t i;
2776 
2777   for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2778     if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
2779 
2780   if (i == dpyinfo->x_dnd_atoms_length) return 0;
2781 
2782   XSETFRAME (frame, f);
2783 
2784   /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2785      but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2786      function expects them to be of size int (i.e. 32).  So to be able to
2787      use that function, put the data in the form it expects if format is 32. */
2788 
2789   if (event->format == 32 && event->format < BITS_PER_LONG)
2790     {
2791       int i;
2792       for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2793         idata[i] = (int) event->data.l[i];
2794       data = (unsigned char *) idata;
2795     }
2796 
2797   vec = Fmake_vector (make_number (4), Qnil);
2798   ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2799                                                event->message_type)));
2800   ASET (vec, 1, frame);
2801   ASET (vec, 2, make_number (event->format));
2802   ASET (vec, 3, x_property_data_to_lisp (f,
2803                                          data,
2804                                          event->message_type,
2805                                          event->format,
2806                                          size));
2807 
2808   mouse_position_for_drop (f, &x, &y);
2809   bufp->kind = DRAG_N_DROP_EVENT;
2810   bufp->frame_or_window = frame;
2811   bufp->timestamp = CurrentTime;
2812   bufp->x = make_number (x);
2813   bufp->y = make_number (y);
2814   bufp->arg = vec;
2815   bufp->modifiers = 0;
2816 
2817   return 1;
2818 }
2819 
2820 DEFUN ("x-send-client-message", Fx_send_client_event,
2821        Sx_send_client_message, 6, 6, 0,
2822        doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2823 
2824 For DISPLAY, specify either a frame or a display name (a string).
2825 If DISPLAY is nil, that stands for the selected frame's display.
2826 DEST may be a number, in which case it is a Window id.  The value 0 may
2827 be used to send to the root window of the DISPLAY.
2828 If DEST is a cons, it is converted to a 32 bit number
2829 with the high 16 bits from the car and the lower 16 bit from the cdr.  That
2830 number is then used as a window id.
2831 If DEST is a frame the event is sent to the outer window of that frame.
2832 A value of nil means the currently selected frame.
2833 If DEST is the string "PointerWindow" the event is sent to the window that
2834 contains the pointer.  If DEST is the string "InputFocus" the event is
2835 sent to the window that has the input focus.
2836 FROM is the frame sending the event.  Use nil for currently selected frame.
2837 MESSAGE-TYPE is the name of an Atom as a string.
2838 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2839 bits.  VALUES is a list of numbers, cons and/or strings containing the values
2840 to send.  If a value is a string, it is converted to an Atom and the value of
2841 the Atom is sent.  If a value is a cons, it is converted to a 32 bit number
2842 with the high 16 bits from the car and the lower 16 bit from the cdr.
2843 If more values than fits into the event is given, the excessive values
2844 are ignored.  */)
2845      (display, dest, from, message_type, format, values)
2846      Lisp_Object display, dest, from, message_type, format, values;
2847 {
2848   struct x_display_info *dpyinfo = check_x_display_info (display);
2849   Window wdest;
2850   XEvent event;
2851   Lisp_Object cons;
2852   int size;
2853   struct frame *f = check_x_frame (from);
2854   int to_root;
2855 
2856   CHECK_STRING (message_type);
2857   CHECK_NUMBER (format);
2858   CHECK_CONS (values);
2859 
2860   if (x_check_property_data (values) == -1)
2861     error ("Bad data in VALUES, must be number, cons or string");
2862 
2863   event.xclient.type = ClientMessage;
2864   event.xclient.format = XFASTINT (format);
2865 
2866   if (event.xclient.format != 8 && event.xclient.format != 16
2867       && event.xclient.format != 32)
2868     error ("FORMAT must be one of 8, 16 or 32");
2869 
2870   if (FRAMEP (dest) || NILP (dest))
2871     {
2872       struct frame *fdest = check_x_frame (dest);
2873       wdest = FRAME_OUTER_WINDOW (fdest);
2874     }
2875   else if (STRINGP (dest))
2876     {
2877       if (strcmp (SDATA (dest), "PointerWindow") == 0)
2878         wdest = PointerWindow;
2879       else if (strcmp (SDATA (dest), "InputFocus") == 0)
2880         wdest = InputFocus;
2881       else
2882         error ("DEST as a string must be one of PointerWindow or InputFocus");
2883     }
2884   else if (INTEGERP (dest))
2885     wdest = (Window) XFASTINT (dest);
2886   else if (FLOATP (dest))
2887     wdest =  (Window) XFLOAT_DATA (dest);
2888   else if (CONSP (dest))
2889     {
2890       if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2891         error ("Both car and cdr for DEST must be numbers");
2892       else
2893         wdest = (Window) cons_to_long (dest);
2894     }
2895   else
2896     error ("DEST must be a frame, nil, string, number or cons");
2897 
2898   if (wdest == 0) wdest = dpyinfo->root_window;
2899   to_root = wdest == dpyinfo->root_window;
2900 
2901   for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2902     ;
2903 
2904   BLOCK_INPUT;
2905 
2906   event.xclient.message_type
2907     = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2908   event.xclient.display = dpyinfo->display;
2909 
2910   /* Some clients (metacity for example) expects sending window to be here
2911      when sending to the root window.  */
2912   event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2913 
2914 
2915   memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2916   x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2917                         event.xclient.format);
2918 
2919   /* If event mask is 0 the event is sent to the client that created
2920      the destination window.  But if we are sending to the root window,
2921      there is no such client.  Then we set the event mask to 0xffff.  The
2922      event then goes to clients selecting for events on the root window.  */
2923   x_catch_errors (dpyinfo->display);
2924   {
2925     int propagate = to_root ? False : True;
2926     unsigned mask = to_root ? 0xffff : 0;
2927     XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2928     XFlush (dpyinfo->display);
2929   }
2930   x_uncatch_errors ();
2931   UNBLOCK_INPUT;
2932 
2933   return Qnil;
2934 }
2935 
2936 
2937 void
2938 syms_of_xselect ()
2939 {
2940   defsubr (&Sx_get_selection_internal);
2941   defsubr (&Sx_own_selection_internal);
2942   defsubr (&Sx_disown_selection_internal);
2943   defsubr (&Sx_selection_owner_p);
2944   defsubr (&Sx_selection_exists_p);
2945 
2946 #ifdef CUT_BUFFER_SUPPORT
2947   defsubr (&Sx_get_cut_buffer_internal);
2948   defsubr (&Sx_store_cut_buffer_internal);
2949   defsubr (&Sx_rotate_cut_buffers_internal);
2950 #endif
2951 
2952   defsubr (&Sx_get_atom_name);
2953   defsubr (&Sx_send_client_message);
2954   defsubr (&Sx_register_dnd_atom);
2955 
2956   reading_selection_reply = Fcons (Qnil, Qnil);
2957   staticpro (&reading_selection_reply);
2958   reading_selection_window = 0;
2959   reading_which_selection = 0;
2960 
2961   property_change_wait_list = 0;
2962   prop_location_identifier = 0;
2963   property_change_reply = Fcons (Qnil, Qnil);
2964   staticpro (&property_change_reply);
2965 
2966   Vselection_alist = Qnil;
2967   staticpro (&Vselection_alist);
2968 
2969   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2970                doc: /* An alist associating X Windows selection-types with functions.
2971 These functions are called to convert the selection, with three args:
2972 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2973 a desired type to which the selection should be converted;
2974 and the local selection value (whatever was given to `x-own-selection').
2975 
2976 The function should return the value to send to the X server
2977 \(typically a string).  A return value of nil
2978 means that the conversion could not be done.
2979 A return value which is the symbol `NULL'
2980 means that a side-effect was executed,
2981 and there is no meaningful selection value.  */);
2982   Vselection_converter_alist = Qnil;
2983 
2984   DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2985                doc: /* A list of functions to be called when Emacs loses an X selection.
2986 \(This happens when some other X client makes its own selection
2987 or when a Lisp program explicitly clears the selection.)
2988 The functions are called with one argument, the selection type
2989 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').  */);
2990   Vx_lost_selection_functions = Qnil;
2991 
2992   DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2993                doc: /* A list of functions to be called when Emacs answers a selection request.
2994 The functions are called with four arguments:
2995   - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2996   - the selection-type which Emacs was asked to convert the
2997     selection into before sending (for example, `STRING' or `LENGTH');
2998   - a flag indicating success or failure for responding to the request.
2999 We might have failed (and declined the request) for any number of reasons,
3000 including being asked for a selection that we no longer own, or being asked
3001 to convert into a type that we don't know about or that is inappropriate.
3002 This hook doesn't let you change the behavior of Emacs's selection replies,
3003 it merely informs you that they have happened.  */);
3004   Vx_sent_selection_functions = Qnil;
3005 
3006   DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
3007               doc: /* Number of milliseconds to wait for a selection reply.
3008 If the selection owner doesn't reply in this time, we give up.
3009 A value of 0 means wait as long as necessary.  This is initialized from the
3010 \"*selectionTimeout\" resource.  */);
3011   x_selection_timeout = 0;
3012 
3013   QPRIMARY   = intern_c_string ("PRIMARY");     staticpro (&QPRIMARY);
3014   QSECONDARY = intern_c_string ("SECONDARY");   staticpro (&QSECONDARY);
3015   QSTRING    = intern_c_string ("STRING");      staticpro (&QSTRING);
3016   QINTEGER   = intern_c_string ("INTEGER");     staticpro (&QINTEGER);
3017   QCLIPBOARD = intern_c_string ("CLIPBOARD");   staticpro (&QCLIPBOARD);
3018   QTIMESTAMP = intern_c_string ("TIMESTAMP");   staticpro (&QTIMESTAMP);
3019   QTEXT      = intern_c_string ("TEXT");        staticpro (&QTEXT);
3020   QCOMPOUND_TEXT = intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
3021   QUTF8_STRING = intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING);
3022   QDELETE    = intern_c_string ("DELETE");      staticpro (&QDELETE);
3023   QMULTIPLE  = intern_c_string ("MULTIPLE");    staticpro (&QMULTIPLE);
3024   QINCR      = intern_c_string ("INCR");                staticpro (&QINCR);
3025   QEMACS_TMP = intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
3026   QTARGETS   = intern_c_string ("TARGETS");     staticpro (&QTARGETS);
3027   QATOM      = intern_c_string ("ATOM");                staticpro (&QATOM);
3028   QATOM_PAIR = intern_c_string ("ATOM_PAIR");   staticpro (&QATOM_PAIR);
3029   QNULL      = intern_c_string ("NULL");                staticpro (&QNULL);
3030   Qcompound_text_with_extensions = intern_c_string ("compound-text-with-extensions");
3031   staticpro (&Qcompound_text_with_extensions);
3032 
3033 #ifdef CUT_BUFFER_SUPPORT
3034   QCUT_BUFFER0 = intern_c_string ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
3035   QCUT_BUFFER1 = intern_c_string ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
3036   QCUT_BUFFER2 = intern_c_string ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
3037   QCUT_BUFFER3 = intern_c_string ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
3038   QCUT_BUFFER4 = intern_c_string ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
3039   QCUT_BUFFER5 = intern_c_string ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
3040   QCUT_BUFFER6 = intern_c_string ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
3041   QCUT_BUFFER7 = intern_c_string ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
3042 #endif
3043 
3044   Qforeign_selection = intern_c_string ("foreign-selection");
3045   staticpro (&Qforeign_selection);
3046 }
3047 
3048 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
3049    (do not change this comment) */