cgit.sxemacs.org Git - sxemacs/blob - src/ui/X11/select-x.c

   1 /* X Selection processing for SXEmacs
   2    Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of SXEmacs
   5
   6 SXEmacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 SXEmacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  18
  19
  20 /* Synched up with: Not synched with FSF. */
  21
  22 /* Rewritten by jwz */
  23
  24 #include <config.h>
  25 #include "lisp.h"
  26
  27 #include "buffer.h"
  28 #include "console-x.h"
  29 #include "objects-x.h"
  30
  31 #include "ui/frame.h"
  32 #include "opaque.h"
  33 #include "systime.h"
  34 #include "ui/select.h"
  35
  36 int lisp_to_time(Lisp_Object, time_t *);
  37 Lisp_Object time_to_lisp(time_t);
  38
  39 #ifdef LWLIB_USES_MOTIF
  40 # define MOTIF_CLIPBOARDS
  41 #endif
  42
  43 #ifdef MOTIF_CLIPBOARDS
  44 # include <Xm/CutPaste.h>
  45 static void hack_motif_clipboard_selection(Atom selection_atom,
  46                                            Lisp_Object selection_value,
  47                                            Time thyme, Display * display,
  48                                            Window selecting_window,
  49                                            int owned_p);
  50 #endif
  51
  52 #define CUT_BUFFER_SUPPORT
  53
  54 #ifdef CUT_BUFFER_SUPPORT
  55 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  56     QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
  57 #endif
  58
  59 Lisp_Object Vx_sent_selection_hooks;
  60
  61 /* If this is a smaller number than the max-request-size of the display,
  62    emacs will use INCR selection transfer when the selection is larger
  63    than this.  The max-request-size is usually around 64k, so if you want
  64    emacs to use incremental selection transfers when the selection is
  65    smaller than that, set this.  I added this mostly for debugging the
  66    incremental transfer stuff, but it might improve server performance.
  67  */
  68 #define MAX_SELECTION_QUANTUM 0xFFFFFF
  69
  70 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
  71
  72 /* If the selection owner takes too long to reply to a selection request,
  73    we give up on it.  This is in seconds (0 = no timeout).
  74  */
  75 Fixnum x_selection_timeout;
  76
  77 /* Enable motif selection optimizations. */
  78 int x_selection_strict_motif_ownership;
  79 \f
  80 /* Utility functions */
  81
  82 static void lisp_data_to_selection_data(struct device *, Lisp_Object obj,
  83                                         unsigned char **data_ret, Atom * type_ret,
  84                                         unsigned int *size_ret, int *format_ret);
  85 static Lisp_Object selection_data_to_lisp_data(struct device *, Extbyte * data,
  86                                                size_t size, Atom type, int format);
  87 static Lisp_Object x_get_window_property_as_lisp_data(Display *, Window, Atom property,
  88                                                       Lisp_Object target_type, Atom selection_atom);
  89
  90 static int expect_property_change(Display *, Window, Atom prop, int state);
  91 static void wait_for_property_change(long);
  92 static void unexpect_property_change(int);
  93 static int
  94 waiting_for_other_props_on_window(Display *, Window)
  95 #if defined __GNUC__
  96         __attribute__((unused));
  97 #endif
  98         ;
  99 /* This converts a Lisp symbol to a server Atom, avoiding a server
 100    roundtrip whenever possible.
 101  */
 102 static Atom
 103 symbol_to_x_atom(struct device *d, Lisp_Object sym, int only_if_exists)
 104 {
 105         Display *display = DEVICE_X_DISPLAY(d);
 106
 107         if (NILP(sym))
 108                 return XA_PRIMARY;
 109         if (EQ(sym, Qt))
 110                 return XA_SECONDARY;
 111         if (EQ(sym, QPRIMARY))
 112                 return XA_PRIMARY;
 113         if (EQ(sym, QSECONDARY))
 114                 return XA_SECONDARY;
 115         if (EQ(sym, QSTRING))
 116                 return XA_STRING;
 117         if (EQ(sym, QINTEGER))
 118                 return XA_INTEGER;
 119         if (EQ(sym, QATOM))
 120                 return XA_ATOM;
 121         if (EQ(sym, QCLIPBOARD))
 122                 return DEVICE_XATOM_CLIPBOARD(d);
 123         if (EQ(sym, QTIMESTAMP))
 124                 return DEVICE_XATOM_TIMESTAMP(d);
 125         if (EQ(sym, QTEXT))
 126                 return DEVICE_XATOM_TEXT(d);
 127         if (EQ(sym, QDELETE))
 128                 return DEVICE_XATOM_DELETE(d);
 129         if (EQ(sym, QMULTIPLE))
 130                 return DEVICE_XATOM_MULTIPLE(d);
 131         if (EQ(sym, QINCR))
 132                 return DEVICE_XATOM_INCR(d);
 133         if (EQ(sym, QEMACS_TMP))
 134                 return DEVICE_XATOM_EMACS_TMP(d);
 135         if (EQ(sym, QTARGETS))
 136                 return DEVICE_XATOM_TARGETS(d);
 137         if (EQ(sym, QNULL))
 138                 return DEVICE_XATOM_NULL(d);
 139         if (EQ(sym, QATOM_PAIR))
 140                 return DEVICE_XATOM_ATOM_PAIR(d);
 141         if (EQ(sym, QCOMPOUND_TEXT))
 142                 return DEVICE_XATOM_COMPOUND_TEXT(d);
 143
 144 #ifdef CUT_BUFFER_SUPPORT
 145         if (EQ(sym, QCUT_BUFFER0))
 146                 return XA_CUT_BUFFER0;
 147         if (EQ(sym, QCUT_BUFFER1))
 148                 return XA_CUT_BUFFER1;
 149         if (EQ(sym, QCUT_BUFFER2))
 150                 return XA_CUT_BUFFER2;
 151         if (EQ(sym, QCUT_BUFFER3))
 152                 return XA_CUT_BUFFER3;
 153         if (EQ(sym, QCUT_BUFFER4))
 154                 return XA_CUT_BUFFER4;
 155         if (EQ(sym, QCUT_BUFFER5))
 156                 return XA_CUT_BUFFER5;
 157         if (EQ(sym, QCUT_BUFFER6))
 158                 return XA_CUT_BUFFER6;
 159         if (EQ(sym, QCUT_BUFFER7))
 160                 return XA_CUT_BUFFER7;
 161 #endif                          /* CUT_BUFFER_SUPPORT */
 162
 163         {
 164                 const char *nameext;
 165                 LISP_STRING_TO_EXTERNAL(Fsymbol_name(sym), nameext, Qctext);
 166                 return XInternAtom(display, nameext,
 167                                    only_if_exists ? True : False);
 168         }
 169 }
 170
 171 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
 172    and calls to intern whenever possible.
 173  */
 174 static Lisp_Object
 175 x_atom_to_symbol(struct device *d, Atom atom)
 176 {
 177         Display *display = DEVICE_X_DISPLAY(d);
 178
 179         if (!atom)
 180                 return Qnil;
 181         if (atom == XA_PRIMARY)
 182                 return QPRIMARY;
 183         if (atom == XA_SECONDARY)
 184                 return QSECONDARY;
 185         if (atom == XA_STRING)
 186                 return QSTRING;
 187         if (atom == XA_INTEGER)
 188                 return QINTEGER;
 189         if (atom == XA_ATOM)
 190                 return QATOM;
 191         if (atom == DEVICE_XATOM_CLIPBOARD(d))
 192                 return QCLIPBOARD;
 193         if (atom == DEVICE_XATOM_TIMESTAMP(d))
 194                 return QTIMESTAMP;
 195         if (atom == DEVICE_XATOM_TEXT(d))
 196                 return QTEXT;
 197         if (atom == DEVICE_XATOM_DELETE(d))
 198                 return QDELETE;
 199         if (atom == DEVICE_XATOM_MULTIPLE(d))
 200                 return QMULTIPLE;
 201         if (atom == DEVICE_XATOM_INCR(d))
 202                 return QINCR;
 203         if (atom == DEVICE_XATOM_EMACS_TMP(d))
 204                 return QEMACS_TMP;
 205         if (atom == DEVICE_XATOM_TARGETS(d))
 206                 return QTARGETS;
 207         if (atom == DEVICE_XATOM_NULL(d))
 208                 return QNULL;
 209         if (atom == DEVICE_XATOM_ATOM_PAIR(d))
 210                 return QATOM_PAIR;
 211         if (atom == DEVICE_XATOM_COMPOUND_TEXT(d))
 212                 return QCOMPOUND_TEXT;
 213
 214 #ifdef CUT_BUFFER_SUPPORT
 215         if (atom == XA_CUT_BUFFER0)
 216                 return QCUT_BUFFER0;
 217         if (atom == XA_CUT_BUFFER1)
 218                 return QCUT_BUFFER1;
 219         if (atom == XA_CUT_BUFFER2)
 220                 return QCUT_BUFFER2;
 221         if (atom == XA_CUT_BUFFER3)
 222                 return QCUT_BUFFER3;
 223         if (atom == XA_CUT_BUFFER4)
 224                 return QCUT_BUFFER4;
 225         if (atom == XA_CUT_BUFFER5)
 226                 return QCUT_BUFFER5;
 227         if (atom == XA_CUT_BUFFER6)
 228                 return QCUT_BUFFER6;
 229         if (atom == XA_CUT_BUFFER7)
 230                 return QCUT_BUFFER7;
 231 #endif
 232
 233         {
 234                 char *intstr;
 235                 char *str = XGetAtomName(display, atom);
 236
 237                 if (!str)
 238                         return Qnil;
 239
 240                 TO_INTERNAL_FORMAT(C_STRING, str,
 241                                    C_STRING_ALLOCA, intstr, Qctext);
 242                 XFree(str);
 243                 return intern(intstr);
 244         }
 245 }
 246 \f
 247 /* Do protocol to assert ourself as a selection owner.
 248  */
 249 static Lisp_Object
 250 x_own_selection(Lisp_Object selection_name, Lisp_Object selection_value,
 251                 Lisp_Object how_to_add, Lisp_Object selection_type, int owned_p)
 252 {
 253         struct device *d = decode_x_device(Qnil);
 254         Display *display = DEVICE_X_DISPLAY(d);
 255         struct frame *sel_frame = selected_frame();
 256         Window selecting_window = XtWindow(FRAME_X_TEXT_WIDGET(sel_frame));
 257         Lisp_Object selection_time;
 258         /* Use the time of the last-read mouse or keyboard event.
 259            For selection purposes, we use this as a sleazy way of knowing what the
 260            current time is in server-time.  This assumes that the most recently read
 261            mouse or keyboard event has something to do with the assertion of the
 262            selection, which is probably true.
 263          */
 264         Time thyme = DEVICE_X_MOUSE_TIMESTAMP(d);
 265         Atom selection_atom;
 266
 267         CHECK_SYMBOL(selection_name);
 268         selection_atom = symbol_to_x_atom(d, selection_name, 0);
 269
 270         XSetSelectionOwner(display, selection_atom, selecting_window, thyme);
 271
 272         /* We do NOT use time_to_lisp() here any more, like we used to.
 273            That assumed equivalence of time_t and Time, which is not
 274            necessarily the case (e.g. under OSF on the Alphas, where
 275            Time is a 64-bit quantity and time_t is a 32-bit quantity).
 276
 277            Opaque pointers are the clean way to go here.
 278          */
 279         selection_time = make_opaque(&thyme, sizeof(thyme));
 280
 281 #ifdef MOTIF_CLIPBOARDS
 282         hack_motif_clipboard_selection(selection_atom, selection_value,
 283                                        thyme, display, selecting_window,
 284                                        owned_p);
 285 #endif
 286         return selection_time;
 287 }
 288
 289 #ifdef MOTIF_CLIPBOARDS         /* Bend over baby.  Take it and like it. */
 290
 291 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
 292 static void motif_clipboard_cb();
 293 # endif
 294
 295 static void
 296 hack_motif_clipboard_selection(Atom selection_atom,
 297                                Lisp_Object selection_value,
 298                                Time thyme,
 299                                Display * display,
 300                                Window selecting_window, int owned_p)
 301 {
 302         struct device *d = get_device_from_display(display);
 303         /* Those Motif wankers can't be bothered to follow the ICCCM, and do
 304            their own non-Xlib non-Xt clipboard processing.  So we have to do
 305            this so that linked-in Motif widgets don't get themselves wedged.
 306          */
 307         if (selection_atom == DEVICE_XATOM_CLIPBOARD(d)
 308             && STRINGP(selection_value)
 309
 310             /* If we already own the clipboard, don't own it again in the Motif
 311                way.  This might lose in some subtle way, since the timestamp won't
 312                be current, but owning the selection on the Motif way does a
 313                SHITLOAD of X protocol, and it makes killing text be incredibly
 314                slow when using an X terminal.  ARRRRGGGHHH!!!!
 315              */
 316             /* No, this is no good, because then Motif text fields don't bother
 317                to look up the new value, and you can't Copy from a buffer, Paste
 318                into a text field, then Copy something else from the buffer and
 319                paste it into the text field -- it pastes the first thing again. */
 320             && (!owned_p
 321                 /* Selectively re-enable this because for most users its
 322                    just too painful - especially over a remote link. */
 323                 || x_selection_strict_motif_ownership)
 324             ) {
 325 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
 326                 Widget widget = FRAME_X_TEXT_WIDGET(selected_frame());
 327 #endif
 328                 long itemid;
 329 #if XmVersion >= 1002
 330                 long dataid;
 331 #else
 332                 int dataid;     /* 1.2 wants long, but 1.1.5 wants int... */
 333 #endif
 334                 XmString fmh;
 335                 String encoding = "STRING";
 336                 const Bufbyte *data = XSTRING_DATA(selection_value);
 337                 Bytecount bytes = XSTRING_LENGTH(selection_value);
 338
 339 #ifdef MULE
 340                 {
 341                         enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
 342                         const Bufbyte *ptr = data, *end = ptr + bytes;
 343                         /* Optimize for the common ASCII case */
 344                         while (ptr <= end) {
 345                                 if (BYTE_ASCII_P(*ptr)) {
 346                                         ptr++;
 347                                         continue;
 348                                 }
 349
 350                                 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
 351                                     (*ptr) == LEADING_BYTE_CONTROL_1) {
 352                                         chartypes = LATIN_1;
 353                                         ptr += 2;
 354                                         continue;
 355                                 }
 356
 357                                 chartypes = WORLD;
 358                                 break;
 359                         }
 360
 361                         if (chartypes == LATIN_1)
 362                                 TO_EXTERNAL_FORMAT(LISP_STRING, selection_value,
 363                                                    ALLOCA, (data, bytes),
 364                                                    Qbinary);
 365                         else if (chartypes == WORLD) {
 366                                 TO_EXTERNAL_FORMAT(LISP_STRING, selection_value,
 367                                                    ALLOCA, (data, bytes),
 368                                                    Qctext);
 369                                 encoding = "COMPOUND_TEXT";
 370                         }
 371                 }
 372 #endif                          /* MULE */
 373
 374                 fmh = XmStringCreateLtoR("Clipboard", XmSTRING_DEFAULT_CHARSET);
 375                 while (ClipboardSuccess !=
 376                        XmClipboardStartCopy(display, selecting_window, fmh,
 377                                             thyme,
 378 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
 379                                             widget, motif_clipboard_cb,
 380 #else
 381                                             0, NULL,
 382 #endif
 383                                             &itemid)) ;
 384                 XmStringFree(fmh);
 385                 while (ClipboardSuccess !=
 386                        XmClipboardCopy(display, selecting_window, itemid,
 387                                        encoding,
 388 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
 389                                        /* O'Reilly examples say size can be 0,
 390                                           but this clearly is not the case. */
 391                                        0, bytes, (int)selecting_window, /* private id */
 392 #else                           /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
 393                                        (XtPointer) data, bytes, 0,
 394 #endif                          /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
 395                                        &dataid)) ;
 396                 while (ClipboardSuccess !=
 397                        XmClipboardEndCopy(display, selecting_window, itemid)) ;
 398         }
 399 }
 400
 401 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
 402 /* I tried to treat the clipboard like a real selection, and not send
 403    the data until it was requested, but it looks like that just doesn't
 404    work at all unless the selection owner and requestor are in different
 405    processes.  From reading the Motif source, it looks like they never
 406    even considered having two widgets in the same application transfer
 407    data between each other using "by-name" clipboard values.  What a
 408    bunch of fuckups.
 409  */
 410 static void
 411 motif_clipboard_cb(Widget widget, int *data_id, int *private_id, int *reason)
 412 {
 413         switch (*reason) {
 414         case XmCR_CLIPBOARD_DATA_REQUEST: {
 415                 Display *dpy = XtDisplay(widget);
 416                 Window window = (Window) * private_id;
 417                 Lisp_Object selection =
 418                         select_convert_out(QCLIPBOARD, Qnil, Qnil);
 419
 420                 /* Whichever lazy git wrote this originally just called abort()
 421                    when anything didn't go their way... */
 422
 423                 /* Try some other text types */
 424                 if (NILP(selection))
 425                         selection =
 426                                 select_convert_out(QCLIPBOARD, QSTRING,
 427                                                    Qnil);
 428                 if (NILP(selection))
 429                         selection =
 430                                 select_convert_out(QCLIPBOARD, QTEXT, Qnil);
 431                 if (NILP(selection))
 432                         selection =
 433                                 select_convert_out(QCLIPBOARD,
 434                                                    QCOMPOUND_TEXT, Qnil);
 435
 436                 if (CONSP(selection) && SYMBOLP(XCAR(selection))
 437                     && (EQ(XCAR(selection), QSTRING)
 438                         || EQ(XCAR(selection), QTEXT)
 439                         || EQ(XCAR(selection), QCOMPOUND_TEXT)))
 440                         selection = XCDR(selection);
 441
 442                 if (NILP(selection))
 443                         signal_error(Qselection_conversion_error,
 444                                      build_string("no selection"));
 445
 446                 if (!STRINGP(selection))
 447                         signal_error(Qselection_conversion_error,
 448                                      build_string
 449                                      ("couldn't convert selection to string"));
 450
 451                 XmClipboardCopyByName(dpy, window, *data_id,
 452                                       (char *)XSTRING_DATA(selection),
 453                                       XSTRING_LENGTH(selection) + 1, 0);
 454                 break;
 455         }
 456         case XmCR_CLIPBOARD_DATA_DELETE:
 457         default:
 458                 /* don't need to free anything */
 459                 break;
 460         }
 461 }
 462 # endif                         /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
 463 #endif                          /* MOTIF_CLIPBOARDS */
 464
 465 /* Send a SelectionNotify event to the requestor with property=None, meaning
 466    we were unable to do what they wanted.
 467  */
 468 static void
 469 x_decline_selection_request(XSelectionRequestEvent * event)
 470 {
 471         XSelectionEvent reply;
 472         reply.type = SelectionNotify;
 473         reply.display = event->display;
 474         reply.requestor = event->requestor;
 475         reply.selection = event->selection;
 476         reply.time = event->time;
 477         reply.target = event->target;
 478         reply.property = None;
 479
 480         XSendEvent(reply.display, reply.requestor, False, 0L,
 481                    (XEvent *) & reply);
 482         XFlush(reply.display);
 483 }
 484
 485 /* Used as an unwind-protect clause so that, if a selection-converter signals
 486    an error, we tell the requestor that we were unable to do what they wanted
 487    before we throw to top-level or go into the debugger or whatever.
 488  */
 489 static Lisp_Object
 490 x_selection_request_lisp_error(Lisp_Object closure)
 491 {
 492         XSelectionRequestEvent *event = (XSelectionRequestEvent *)
 493             get_opaque_ptr(closure);
 494
 495         free_opaque_ptr(closure);
 496         if (event->type == 0)   /* we set this to mean "completed normally" */
 497                 return Qnil;
 498         x_decline_selection_request(event);
 499         return Qnil;
 500 }
 501
 502 /* Convert our selection to the requested type, and put that data where the
 503    requestor wants it.  Then tell them whether we've succeeded.
 504  */
 505 static void
 506 x_reply_selection_request(XSelectionRequestEvent * event, int format,
 507                           unsigned char *data, int size, Atom type)
 508 {
 509         /* This function can GC */
 510         XSelectionEvent reply;
 511         Display *display = event->display;
 512 #ifdef HAVE_XTREGISTERDRAWABLE
 513         struct device *d = get_device_from_display(display);
 514 #endif
 515         Window window = event->requestor;
 516         int bytes_remaining;
 517         int format_bytes = format / 8;
 518         int max_bytes = SELECTION_QUANTUM(display);
 519         if (max_bytes > MAX_SELECTION_QUANTUM)
 520                 max_bytes = MAX_SELECTION_QUANTUM;
 521
 522         reply.type = SelectionNotify;
 523         reply.display = display;
 524         reply.requestor = window;
 525         reply.selection = event->selection;
 526         reply.time = event->time;
 527         reply.target = event->target;
 528         reply.property =
 529             (event->property == None ? event->target : event->property);
 530
 531         /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
 532
 533         /* Store the data on the requested property.
 534            If the selection is large, only store the first N bytes of it.
 535          */
 536         bytes_remaining = size * format_bytes;
 537         if (bytes_remaining <= max_bytes) {
 538                 /* Send all the data at once, with minimal handshaking. */
 539 #if 0
 540                 stderr_out("\nStoring all %d\n", bytes_remaining);
 541 #endif
 542                 XChangeProperty(display, window, reply.property, type, format,
 543                                 PropModeReplace, data, size);
 544                 /* At this point, the selection was successfully stored; ack it. */
 545                 XSendEvent(display, window, False, 0L, (XEvent *) & reply);
 546                 XFlush(display);
 547         } else {
 548 #ifndef HAVE_XTREGISTERDRAWABLE
 549                 invalid_operation("Copying that much data requires X11R6.", Qunbound);
 550 #else
 551                 /* Send an INCR selection. */
 552                 int prop_id;
 553                 Widget widget = FRAME_X_TEXT_WIDGET (XFRAME(DEVICE_SELECTED_FRAME(d)));
 554
 555                 if (x_window_to_frame(d, window))       /* #### debug */
 556                         error("attempt to transfer an INCR to ourself!");
 557 #if 0
 558                 stderr_out("\nINCR %d\n", bytes_remaining);
 559 #endif
 560       /* Tell Xt not to drop PropertyNotify events that arrive for the
 561          target window, rather, pass them to us. This would be a hack, but
 562          the Xt selection routines are broken for our purposes--we can't
 563          pass them callbacks from Lisp, for example. Let's call it a
 564          workaround.
 565
 566          The call to wait_for_property_change means we can break out of that
 567          function, switch to another frame on the same display (which will
 568          be another Xt widget), select a huge amount of text, and have the
 569          same (foreign) app ask for another incremental selection
 570          transfer. Programming like X11 made sense, would mean that, in that
 571          case, XtRegisterDrawable is called twice with different widgets.
 572
 573          Since the results of calling XtRegisterDrawable when the drawable
 574          is already registered with another widget are undefined, we want to
 575          avoid that--so, only call it when XtWindowToWidget returns NULL,
 576          which it will only do with a valid Window if it's not already
 577          registered. */
 578                 if (NULL == XtWindowToWidget(display, window)) {
 579                         XtRegisterDrawable(display, (Drawable)window, widget);
 580                 }
 581
 582                 prop_id =
 583                     expect_property_change(display, window, reply.property,
 584                                            PropertyDelete);
 585
 586                 XChangeProperty(display, window, reply.property,
 587                                 DEVICE_XATOM_INCR(d), 32, PropModeReplace,
 588                                 (unsigned char *)
 589                                 &bytes_remaining, 1);
 590                 XSelectInput(display, window, PropertyChangeMask);
 591                 /* Tell 'em the INCR data is there... */
 592                 XSendEvent(display, window, False, 0L, (XEvent *) & reply);
 593                 XFlush(display);
 594
 595                 /* First, wait for the requestor to ack by deleting the property.
 596                    This can run random lisp code (process handlers) or signal.
 597                  */
 598                 wait_for_property_change(prop_id);
 599
 600                 while (bytes_remaining) {
 601                         int i = ((bytes_remaining < max_bytes)
 602                                  ? bytes_remaining : max_bytes);
 603                         prop_id =
 604                             expect_property_change(display, window,
 605                                                    reply.property,
 606                                                    PropertyDelete);
 607 #if 0
 608                         stderr_out("  INCR adding %d\n", i);
 609 #endif
 610                         /* Append the next chunk of data to the property. */
 611                         XChangeProperty(display, window, reply.property, type,
 612                                         format, PropModeAppend, data,
 613                                         i / format_bytes);
 614                         bytes_remaining -= i;
 615                         data += i;
 616
 617                         /* Now wait for the requestor to ack this chunk by deleting the
 618                            property.   This can run random lisp code or signal.
 619                          */
 620                         wait_for_property_change(prop_id);
 621                 }
 622                 /* Now write a zero-length chunk to the property to tell the requestor
 623                    that we're done. */
 624 #if 0
 625                 stderr_out("  INCR done\n");
 626 #endif
 627                 if (!waiting_for_other_props_on_window(display, window)) {
 628                         XSelectInput(display, window, 0L);
 629                         XtUnregisterDrawable(display, (Drawable)window);
 630                 }
 631
 632                 XChangeProperty(display, window, reply.property, type, format,
 633                                 PropModeReplace, data, 0);
 634 #endif  /* HAVE_XTREGISTERDRAWABLE */
 635         }
 636 }
 637
 638 /* Called from the event-loop in response to a SelectionRequest event.
 639  */
 640 void
 641 x_handle_selection_request(XSelectionRequestEvent * event)
 642 {
 643         /* This function can GC */
 644         struct gcpro gcpro1, gcpro2;
 645         Lisp_Object temp_obj;
 646         Lisp_Object selection_symbol;
 647         Lisp_Object target_symbol = Qnil;
 648         Lisp_Object converted_selection = Qnil;
 649         Time local_selection_time;
 650         Lisp_Object successful_p = Qnil;
 651         int count;
 652         struct device *d = get_device_from_display(event->display);
 653
 654         GCPRO2(converted_selection, target_symbol);
 655
 656         selection_symbol = x_atom_to_symbol(d, event->selection);
 657         target_symbol = x_atom_to_symbol(d, event->target);
 658
 659 #if 0                           /* #### MULTIPLE doesn't work yet */
 660         if (EQ(target_symbol, QMULTIPLE))
 661                 target_symbol = fetch_multiple_target(event);
 662 #endif
 663
 664         temp_obj = Fget_selection_timestamp(selection_symbol);
 665
 666         if (NILP(temp_obj)) {
 667                 /* We don't appear to have the selection. */
 668                 x_decline_selection_request(event);
 669
 670                 goto DONE_LABEL;
 671         }
 672
 673         local_selection_time = *(Time *) XOPAQUE_DATA(temp_obj);
 674
 675         if (event->time != CurrentTime && local_selection_time > event->time) {
 676                 /* Someone asked for the selection, and we have one, but not the one
 677                    they're looking for. */
 678                 x_decline_selection_request(event);
 679                 goto DONE_LABEL;
 680         }
 681
 682         converted_selection = select_convert_out(selection_symbol,
 683                                                  target_symbol, Qnil);
 684
 685         /* #### Is this the right thing to do? I'm no X expert. -- ajh */
 686         if (NILP(converted_selection)) {
 687                 /* We don't appear to have a selection in that data type. */
 688                 x_decline_selection_request(event);
 689                 goto DONE_LABEL;
 690         }
 691
 692         count = specpdl_depth();
 693         record_unwind_protect(x_selection_request_lisp_error,
 694                               make_opaque_ptr(event));
 695
 696         {
 697                 unsigned char *data;
 698                 unsigned int size;
 699                 int format;
 700                 Atom type;
 701                 lisp_data_to_selection_data(d, converted_selection,
 702                                             &data, &type, &size, &format);
 703
 704                 x_reply_selection_request(event, format, data, size, type);
 705                 successful_p = Qt;
 706                 /* Tell x_selection_request_lisp_error() it's cool. */
 707                 event->type = 0;
 708                 xfree(data);
 709         }
 710
 711         unbind_to(count, Qnil);
 712
 713       DONE_LABEL:
 714
 715         UNGCPRO;
 716
 717         /* Let random lisp code notice that the selection has been asked for. */
 718         {
 719                 Lisp_Object val = Vx_sent_selection_hooks;
 720                 if (!UNBOUNDP(val) && !NILP(val)) {
 721                         Lisp_Object rest;
 722                         if (CONSP(val) && !EQ(XCAR(val), Qlambda))
 723                                 for (rest = val; !NILP(rest); rest = Fcdr(rest))
 724                                         call3(Fcar(rest), selection_symbol,
 725                                               target_symbol, successful_p);
 726                         else
 727                                 call3(val, selection_symbol, target_symbol,
 728                                       successful_p);
 729                 }
 730         }
 731 }
 732
 733 /* Called from the event-loop in response to a SelectionClear event.
 734  */
 735 void
 736 x_handle_selection_clear(XSelectionClearEvent * event)
 737 {
 738         Display *display = event->display;
 739         struct device *d = get_device_from_display(display);
 740         Atom selection = event->selection;
 741         Time changed_owner_time = event->time;
 742
 743         Lisp_Object selection_symbol, local_selection_time_lisp;
 744         Time local_selection_time;
 745
 746         selection_symbol = x_atom_to_symbol(d, selection);
 747
 748         local_selection_time_lisp = Fget_selection_timestamp(selection_symbol);
 749
 750         /* We don't own the selection, so that's fine. */
 751         if (NILP(local_selection_time_lisp))
 752                 return;
 753
 754         local_selection_time =
 755             *(Time *) XOPAQUE_DATA(local_selection_time_lisp);
 756
 757         /* This SelectionClear is for a selection that we no longer own, so we can
 758            disregard it.  (That is, we have reasserted the selection since this
 759            request was generated.)
 760          */
 761         if (changed_owner_time != CurrentTime &&
 762             local_selection_time > changed_owner_time)
 763                 return;
 764
 765         handle_selection_clear(selection_symbol);
 766 }
 767 \f
 768 /* This stuff is so that INCR selections are reentrant (that is, so we can
 769    be servicing multiple INCR selection requests simultaneously).  I haven't
 770    actually tested that yet.
 771  */
 772
 773 static int prop_location_tick;
 774
 775 static struct prop_location {
 776         int tick;
 777         Display *display;
 778         Window window;
 779         Atom property;
 780         int desired_state;
 781         struct prop_location *next;
 782 } *for_whom_the_bell_tolls;
 783
 784 static int
 785 property_deleted_p(void *tick)
 786 {
 787         struct prop_location *rest = for_whom_the_bell_tolls;
 788         while (rest)
 789                 if (rest->tick == (long)tick)
 790                         return 0;
 791                 else
 792                         rest = rest->next;
 793         return 1;
 794 }
 795
 796 static int
 797 waiting_for_other_props_on_window(Display * display, Window window)
 798 {
 799         struct prop_location *rest = for_whom_the_bell_tolls;
 800         while (rest)
 801                 if (rest->display == display && rest->window == window)
 802                         return 1;
 803                 else
 804                         rest = rest->next;
 805         return 0;
 806 }
 807
 808 static int
 809 expect_property_change(Display * display, Window window,
 810                        Atom property, int state)
 811 {
 812         struct prop_location *pl = xnew(struct prop_location);
 813         pl->tick = ++prop_location_tick;
 814         pl->display = display;
 815         pl->window = window;
 816         pl->property = property;
 817         pl->desired_state = state;
 818         pl->next = for_whom_the_bell_tolls;
 819         for_whom_the_bell_tolls = pl;
 820         return pl->tick;
 821 }
 822
 823 static void
 824 unexpect_property_change(int tick)
 825 {
 826         struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
 827         while (rest) {
 828                 if (rest->tick == tick) {
 829                         if (prev)
 830                                 prev->next = rest->next;
 831                         else
 832                                 for_whom_the_bell_tolls = rest->next;
 833                         xfree(rest);
 834                         return;
 835                 }
 836                 prev = rest;
 837                 rest = rest->next;
 838         }
 839 }
 840
 841 static void
 842 wait_for_property_change(long tick)
 843 {
 844         /* This function can GC */
 845         wait_delaying_user_input(property_deleted_p, (void *)tick);
 846 }
 847
 848 /*
 849  * Called from the event-loop in response to a PropertyNotify event.
 850  */
 851 void
 852 x_handle_property_notify(XPropertyEvent * event)
 853 {
 854         struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
 855         while (rest) {
 856                 if (rest->property == event->atom &&
 857                     rest->window == event->window &&
 858                     rest->display == event->display &&
 859                     rest->desired_state == event->state)
 860                 {
 861                         if (prev)
 862                                 prev->next = rest->next;
 863                         else
 864                                 for_whom_the_bell_tolls = rest->next;
 865                         xfree(rest);
 866                         return;
 867                 }
 868                 prev = rest; rest = rest->next;
 869         }
 870 }
 871
 872 \f
 873 #if 0                           /* #### MULTIPLE doesn't work yet */
 874 static Lisp_Object
 875 fetch_multiple_target(XSelectionRequestEvent * event)
 876 {
 877         /* This function can GC */
 878         Display * display = event->display;
 879         Window window = event->requestor;
 880         Atom target = event->target;
 881         Atom selection_atom = event->selection;
 882         int result;
 883
 884         return Fcons(QMULTIPLE, x_get_window_property_as_lisp_data
 885                      (display, window, target, QMULTIPLE, selection_atom));
 886 }
 887
 888 static Lisp_Object
 889 copy_multiple_data(Lisp_Object obj)
 890 {
 891         Lisp_Object vec;
 892         int i; int len;
 893
 894         if (CONSP(obj))
 895                 return Fcons(XCAR(obj), copy_multiple_data(XCDR(obj)));
 896
 897         CHECK_VECTOR(obj); len = XVECTOR_LENGTH(obj);
 898         vec = make_vector(len, Qnil);
 899         for (i = 0; i < len; i++) {
 900                 Lisp_Object vec2 = XVECTOR_DATA(obj)[i];
 901                 CHECK_VECTOR(vec2);
 902                 if (XVECTOR_LENGTH(vec2) != 2)
 903                         signal_error(Qerror, list2(build_string ("vectors must be of length 2"), vec2));
 904                 XVECTOR_DATA(vec)[i] = make_vector(2, Qnil);
 905                 XVECTOR_DATA(XVECTOR_DATA(vec)[i])[0] =
 906                         XVECTOR_DATA(vec2)[0];
 907                 XVECTOR_DATA(XVECTOR_DATA(vec)[i])[1] =
 908                         XVECTOR_DATA(vec2)[1];
 909         }
 910         return vec;
 911 }
 912 #endif /* 0 */
 913
 914 \f
 915 static Window reading_selection_reply;
 916 static Atom reading_which_selection;
 917 static int selection_reply_timed_out;
 918
 919 static int
 920 selection_reply_done(void *ignore)
 921 {
 922         return !reading_selection_reply;
 923 }
 924
 925 static Lisp_Object Qx_selection_reply_timeout_internal;
 926
 927 DEFUN("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, 1, 1, 0, /*
 928 */
 929       (arg))
 930 {
 931         selection_reply_timed_out = 1;
 932         reading_selection_reply = 0;
 933
 934         return Qnil;
 935 }
 936
 937 /*
 938  * Do protocol to read selection-data from the server.
 939  * Converts this to lisp data and returns it.
 940  */
 941 static Lisp_Object
 942 x_get_foreign_selection(Lisp_Object selection_symbol, Lisp_Object target_type)
 943 {
 944         /* This function can GC */
 945         struct device *d = decode_x_device(Qnil);
 946         Display * display = DEVICE_X_DISPLAY(d);
 947         struct frame *sel_frame = selected_frame();
 948         Window requestor_window = XtWindow(FRAME_X_TEXT_WIDGET(sel_frame));
 949         Time requestor_time = CurrentTime;
 950         Atom target_property = DEVICE_XATOM_EMACS_TMP(d);
 951         Atom selection_atom = symbol_to_x_atom(d, selection_symbol, 0);
 952         int speccount;
 953         Atom type_atom = symbol_to_x_atom(d, (CONSP(target_type) ? XCAR(target_type) : target_type), 0);
 954
 955         XConvertSelection(display, selection_atom, type_atom, target_property,
 956                           requestor_window, requestor_time);
 957         /* Block until the reply has been read. */
 958         reading_selection_reply = requestor_window;
 959         reading_which_selection = selection_atom;
 960         selection_reply_timed_out = 0;
 961         speccount = specpdl_depth();
 962         /* add a timeout handler */
 963         if (x_selection_timeout > 0) {
 964                 Lisp_Object id = Fadd_timeout(make_int(x_selection_timeout),
 965                                               Qx_selection_reply_timeout_internal,
 966                                               Qnil, Qnil);
 967                 record_unwind_protect(Fdisable_timeout, id);
 968         }
 969
 970         /* This is ^Gable */
 971         wait_delaying_user_input(selection_reply_done, 0);
 972         if (selection_reply_timed_out)
 973                 error("timed out waiting for reply from selection owner");
 974         unbind_to(speccount, Qnil);
 975         /* otherwise, the selection is waiting for us on the requested property. */
 976         return select_convert_in(selection_symbol, target_type,
 977                                  x_get_window_property_as_lisp_data (display, requestor_window,
 978                                                                      target_property, target_type,
 979                                                                      selection_atom));
 980 }
 981
 982 static void
 983 x_get_window_property(Display * display, Window window, Atom property,
 984                       Extbyte ** data_ret, int *bytes_ret, Atom * actual_type_ret,
 985                       int *actual_format_ret, unsigned long *actual_size_ret,
 986                       int delete_p)
 987 {
 988         size_t total_size;
 989         unsigned long bytes_remaining;
 990         int offset = 0; unsigned char *tmp_data = 0;
 991         int result;
 992         int buffer_size = SELECTION_QUANTUM(display);
 993
 994         if (buffer_size > MAX_SELECTION_QUANTUM)
 995                 buffer_size = MAX_SELECTION_QUANTUM;
 996         /* First probe the thing to find out how big it is. */
 997         result = XGetWindowProperty(display, window, property, 0, 0,
 998                                     False, AnyPropertyType, actual_type_ret,
 999                                    actual_format_ret, actual_size_ret,
1000                                    &bytes_remaining, &tmp_data);
1001         if (result != Success) {
1002                 *data_ret = 0;
1003                 *bytes_ret = 0;
1004                 return;
1005         }
1006         XFree((char *)tmp_data);
1007         if (*actual_type_ret == None || *actual_format_ret == 0) {
1008                 if (delete_p)
1009                         XDeleteProperty(display, window, property);
1010                 *data_ret = 0;
1011                 *bytes_ret = 0;
1012                 return;
1013         }
1014
1015         total_size = bytes_remaining + 1;
1016         *data_ret = (Extbyte *) xmalloc_atomic(total_size);
1017         /* Now read, until we've gotten it all. */
1018         while (bytes_remaining) {
1019                 result = XGetWindowProperty(display, window, property,
1020                                            offset / 4, buffer_size / 4,
1021                                            (delete_p ? True : False),
1022                                            AnyPropertyType, actual_type_ret,
1023                                            actual_format_ret, actual_size_ret,
1024                                            &bytes_remaining, &tmp_data);
1025
1026                 /* If this doesn't return Success at this point, it means that
1027                    some clod deleted the selection while we were in the midst of
1028                    reading it.  Deal with that, I guess....
1029                 */
1030                 if (result != Success)
1031                         break;
1032                 *actual_size_ret *= *actual_format_ret / 8;
1033                 memcpy((*data_ret) + offset, tmp_data, *actual_size_ret);
1034                 offset += *actual_size_ret;
1035                 XFree((char *)tmp_data);
1036         }
1037         *bytes_ret = offset;
1038 }
1039
1040 static void
1041 receive_incremental_selection(Display * display, Window window, Atom property,
1042                               /* this one is for error messages only */
1043                               Lisp_Object target_type, unsigned int min_size_bytes,
1044                               Extbyte ** data_ret, int *size_bytes_ret,
1045                               Atom * type_ret, int *format_ret,
1046                               unsigned long *size_ret)
1047 {
1048         /* This function can GC */
1049         int offset = 0;
1050         int prop_id;
1051
1052         *size_bytes_ret = min_size_bytes;
1053         *data_ret = (Extbyte *) xmalloc_atomic(*size_bytes_ret);
1054
1055         /* At this point, we have read an INCR property, and deleted it (which
1056            is how we ack its receipt: the sending window will be selecting
1057            PropertyNotify events on our window to notice this).
1058
1059            Now, we must loop, waiting for the sending window to put a value on
1060            that property, then reading the property, then deleting it to ack.
1061            We are done when the sender places a property of length 0.
1062         */
1063         prop_id = expect_property_change(display, window, property, PropertyNewValue);
1064         while (1) {
1065                 Extbyte * tmp_data; int tmp_size_bytes;
1066                 wait_for_property_change(prop_id);
1067                 /* expect it again immediately, because x_get_window_property may
1068                    .. no it won't, I don't get it.
1069                    .. Ok, I get it now, the Xt code that implements INCR is broken.
1070                 */
1071                 prop_id = expect_property_change(display, window, property, PropertyNewValue);
1072                 x_get_window_property(display, window, property, &tmp_data, &tmp_size_bytes,
1073                                       type_ret, format_ret, size_ret, 1);
1074                 if (tmp_size_bytes == 0) {      /* we're done */
1075                         unexpect_property_change(prop_id);
1076                         if (tmp_data) xfree(tmp_data);
1077                         break;
1078                 }
1079                 if (*size_bytes_ret < offset + tmp_size_bytes) {
1080                         *size_bytes_ret = offset + tmp_size_bytes;
1081                         *data_ret = (Extbyte *) xrealloc(*data_ret, *size_bytes_ret);
1082                 }
1083                 memcpy((*data_ret) + offset, tmp_data, tmp_size_bytes);
1084                 offset += tmp_size_bytes; xfree(tmp_data);
1085         }
1086 }
1087
1088 static Lisp_Object
1089 x_get_window_property_as_lisp_data(Display * display, Window window, Atom property,
1090                                    /* next two for error messages only */
1091                                    Lisp_Object target_type, Atom selection_atom)
1092 {
1093         /* This function can GC */
1094         Atom actual_type;
1095         int actual_format;
1096         unsigned long actual_size;
1097         Extbyte * data = NULL;
1098         int bytes = 0;
1099         Lisp_Object val;
1100         struct device *d = get_device_from_display(display);
1101
1102         x_get_window_property(display, window, property, &data, &bytes, &actual_type,
1103                               &actual_format, &actual_size, 1);
1104         if (!data) {
1105                 if (XGetSelectionOwner(display, selection_atom))
1106                         /* there is a selection owner */
1107                         signal_error(Qselection_conversion_error,
1108                                      Fcons(build_string("selection owner couldn't convert"),
1109                                            Fcons(x_atom_to_symbol (d, selection_atom),
1110                                                  actual_type ? list2(target_type, x_atom_to_symbol (d, actual_type))
1111                                                  : list1(target_type))));
1112                         else
1113                                 signal_error(Qerror, list2(build_string ("no selection"),
1114                                                            x_atom_to_symbol(d, selection_atom)));
1115         }
1116
1117         if (actual_type == DEVICE_XATOM_INCR(d)) {
1118                 /* Ok, that data wasn't *the* data, it was just the beginning. */
1119                 unsigned int min_size_bytes = *((unsigned int *)data); xfree(data);
1120                 receive_incremental_selection(display, window, property, target_type,
1121                                               min_size_bytes, &data, &bytes, &actual_type,
1122                                               &actual_format, &actual_size);
1123         }
1124
1125         /* It's been read.  Now convert it to a lisp object in some semi-rational
1126            manner. */
1127         val = selection_data_to_lisp_data(d, data, bytes, actual_type, actual_format);
1128         xfree(data);
1129         return val;
1130 }
1131
1132 \f
1133 /* #### These are going to move into Lisp code(!) with the aid of
1134    some new functions I'm working on - ajh */
1135
1136 /* These functions convert from the selection data read from the server into
1137    something that we can use from elisp, and vice versa.
1138
1139    Type:        Format: Size:           Elisp Type:
1140    -----        ------- -----           -----------
1141    *    8       *               String
1142    ATOM 32      1               Symbol
1143    ATOM 32      > 1             Vector of Symbols
1144    *    16      1               Integer
1145    *    16      > 1             Vector of Integers
1146    *    32      1               if <=16 bits: Integer
1147    if > 16 bits: Cons of top16, bot16
1148    *    32      > 1             Vector of the above
1149
1150    When converting a Lisp number to C, it is assumed to be of format 16 if
1151    it is an integer, and of format 32 if it is a cons of two integers.
1152
1153    When converting a vector of numbers from Elisp to C, it is assumed to be
1154    of format 16 if every element in the vector is an integer, and is assumed
1155    to be of format 32 if any element is a cons of two integers.
1156
1157    When converting an object to C, it may be of the form (SYMBOL . <data>)
1158    where SYMBOL is what we should claim that the type is.  Format and
1159    representation are as above.
1160
1161    NOTE: Under Mule, when someone shoves us a string without a type, we
1162    set the type to 'COMPOUND_TEXT and automatically convert to Compound
1163    Text.  If the string has a type, we assume that the user wants the
1164    data sent as-is so we just do "binary" conversion.
1165 */
1166
1167 static Lisp_Object
1168 selection_data_to_lisp_data(struct device *d, Extbyte * data,
1169                             size_t size, Atom type, int format)
1170 {
1171         if (type == DEVICE_XATOM_NULL(d))
1172                 return QNULL;
1173         /* Convert any 8-bit data to a string, for compactness. */
1174         else if (format == 8)
1175                 return make_ext_string(data, size, type == DEVICE_XATOM_TEXT(d)
1176                                        || type == DEVICE_XATOM_COMPOUND_TEXT(d) ? Qctext : Qbinary);
1177         /* Convert a single atom to a Lisp Symbol.
1178            Convert a set of atoms to a vector of symbols. */
1179         else if (type == XA_ATOM) {
1180                 if (size == sizeof(Atom))
1181                         return x_atom_to_symbol(d, *((Atom *) data));
1182                 else {
1183                         int i;
1184                         int len = size / sizeof(Atom);
1185                         Lisp_Object v = Fmake_vector(make_int(len), Qzero);
1186                         for (i = 0; i < len; i++)
1187                                 Faset(v, make_int(i), x_atom_to_symbol(d, ((Atom *) data)[i]));
1188                         return v;
1189                 }
1190         }
1191
1192         /* Convert a single 16 or small 32 bit number to a Lisp Int.
1193            If the number is > 16 bits, convert it to a cons of integers,
1194            16 bits in each half.
1195         */
1196         else if (format == 32 && size == sizeof(long))
1197                 return word_to_lisp(((unsigned long *)data)[0]);
1198         else if (format == 16 && size == sizeof(short))
1199                 return make_int((int)(((unsigned short *)data)[0]));
1200         /* Convert any other kind of data to a vector of numbers, represented
1201            as above (as an integer, or a cons of two 16 bit integers).
1202
1203            #### Perhaps we should return the actual type to lisp as well.
1204
1205            (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1206            ==> [4 4]
1207
1208            and perhaps it should be
1209
1210            (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1211            ==> (SPAN . [4 4])
1212
1213            Right now the fact that the return type was SPAN is discarded before
1214            lisp code gets to see it.
1215         */
1216         else if (format == 16) {
1217                 int i;
1218                 Lisp_Object v = make_vector(size / 4, Qzero);
1219                 for (i = 0; i < (int)size / 4; i++) {
1220                         int j = (int)((unsigned short *)data)[i];
1221                         Faset(v, make_int(i), make_int(j));
1222                 }
1223                 return v;
1224         } else {
1225                 int i;
1226                 Lisp_Object v = make_vector(size / 4, Qzero);
1227                 for (i = 0; i < (int)size / 4; i++) {
1228                         unsigned long j = ((unsigned long *)data)[i];
1229                         Faset(v, make_int(i), word_to_lisp(j));
1230                 }
1231                 return v;
1232         }
1233 }
1234
1235 #define tmp_err_1                               \
1236         "all elements of the vector must be of the same type"
1237 #define tmp_err_2                                                       \
1238         "elements of the vector must be vectors of exactly two elements"
1239 #define tmp_err_3                               \
1240         "all elements of the vector must be of the same type"
1241 #define tmp_err_4                               \
1242         "all elements of the vector must be integers or conses of integers"
1243
1244 static void
1245 lisp_data_to_selection_data(struct device *d, Lisp_Object obj,
1246                             unsigned char **data_ret, Atom * type_ret,
1247                             unsigned int *size_ret, int *format_ret)
1248 {
1249         Lisp_Object type = Qnil;
1250
1251         if (CONSP(obj) && SYMBOLP(XCAR(obj))) {
1252                 type = XCAR(obj); obj = XCDR(obj);
1253                 if (CONSP(obj) && NILP(XCDR(obj)))
1254                         obj = XCAR(obj);
1255         }
1256         if (EQ(obj, QNULL) || (EQ(type, QNULL))) {
1257                 /* This is not the same as declining */
1258                 *format_ret = 32;
1259                 *size_ret = 0; *data_ret = 0; type = QNULL;
1260         } else if (STRINGP(obj)) {
1261                 const Extbyte * extval = NULL;
1262                 Extcount extvallen;
1263                 TO_EXTERNAL_FORMAT(LISP_STRING, obj, ALLOCA, (extval, extvallen),
1264                                    (NILP(type) ? Qctext : Qbinary));
1265                 if ( extval != NULL ) {
1266                         *format_ret = 8;
1267                         *size_ret = extvallen;
1268                         *data_ret = (unsigned char *)xmalloc_atomic(*size_ret);
1269                         memcpy(*data_ret, extval, *size_ret);
1270                 } else {
1271                         error("Could not transcode string");
1272                 }
1273 #ifdef MULE
1274                 if (NILP(type))
1275                         type = QCOMPOUND_TEXT;
1276 #else
1277                 if (NILP(type)) type = QSTRING;
1278 #endif
1279         } else if (CHARP(obj)) {
1280                 Bufbyte buf[MAX_EMCHAR_LEN];
1281                 Bytecount len;
1282                 const Extbyte * extval = NULL;
1283                 Extcount extvallen;
1284                 *format_ret = 8;
1285                 len = set_charptr_emchar(buf, XCHAR(obj));
1286                 TO_EXTERNAL_FORMAT(DATA, (buf, len), ALLOCA, (extval, extvallen),
1287                                    Qctext);
1288                 if ( extval != NULL ) {
1289                         *size_ret = extvallen;
1290                         *data_ret = (unsigned char *)xmalloc_atomic(*size_ret);
1291                         memcpy(*data_ret, extval, *size_ret);
1292                 } else {
1293                         error("Could not transcode data");
1294                 }
1295 #ifdef MULE
1296                 if (NILP(type))
1297                         type = QCOMPOUND_TEXT;
1298 #else
1299                 if (NILP(type))
1300                         type = QSTRING;
1301 #endif
1302         } else if (SYMBOLP(obj)) {
1303                 *format_ret = 32;
1304                 *size_ret = 1;
1305                 *data_ret =
1306                         (unsigned char *)xmalloc_atomic(sizeof(Atom) + 1);
1307                 (*data_ret)[sizeof(Atom)] = 0;
1308                 (*(Atom **) data_ret)[0] =
1309                         symbol_to_x_atom(d, obj, 0);
1310                 if (NILP(type)) type = QATOM;
1311         } else if (INTP(obj) && XINT(obj) <= 0x7FFF && XINT(obj) >= -0x8000) {
1312                 *format_ret = 16;
1313                 *size_ret = 1;
1314                 *data_ret = (unsigned char *)xmalloc_atomic(sizeof(short) + 1);
1315                 (*data_ret)[sizeof(short)] = 0;
1316                 (*(short **)data_ret)[0] = (short)XINT(obj);
1317                 if (NILP(type))
1318                         type = QINTEGER;
1319         } else if (INTP(obj) || CONSP(obj)) {
1320                 *format_ret = 32;
1321                 *size_ret = 1;
1322                 *data_ret = (unsigned char *)xmalloc_atomic(sizeof(long) + 1);
1323                 (*data_ret)[sizeof(long)] = 0;
1324                 (*(unsigned long **)data_ret)[0] = lisp_to_word(obj);
1325                 if (NILP(type))
1326                         type = QINTEGER;
1327         } else if (VECTORP(obj)) {
1328                 /* Lisp Vectors may represent a set of ATOMs;
1329                    a set of 16 or 32 bit INTEGERs;
1330                    or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1331                 */
1332                 int i;
1333                 if (SYMBOLP(XVECTOR_DATA(obj)[0])) {
1334                         /* This vector is an ATOM set */
1335                         if (NILP(type)) {
1336                                 type = QATOM;
1337                         }
1338                         *size_ret = XVECTOR_LENGTH(obj);
1339                         *format_ret = 32;
1340                         *data_ret = (unsigned char *)xmalloc_atomic(
1341                                 (*size_ret) * sizeof(Atom));
1342                         for (i = 0; i < (int)(*size_ret); i++) {
1343                                 if (SYMBOLP(XVECTOR_DATA(obj)[i])) {
1344                                         (*(Atom **) data_ret)[i] =
1345                                                 symbol_to_x_atom(
1346                                                         d,
1347                                                         XVECTOR_DATA(obj)[i], 0);
1348                                 } else {
1349                                         /* was: Qselection_error */
1350                                         signal_error(
1351                                                 Qerror,
1352                                                 list2(build_string(tmp_err_1),
1353                                                       obj));
1354                                 }
1355                         }
1356
1357 #if 0                           /* #### MULTIPLE doesn't work yet */
1358                 } else if (VECTORP(XVECTOR_DATA(obj)[0])) {
1359                         /* This vector is an ATOM_PAIR set */
1360                         if (NILP(type)) type = QATOM_PAIR;
1361                         *size_ret = XVECTOR_LENGTH(obj);
1362                         *format_ret = 32;
1363                         *data_ret = (unsigned char *)
1364                                 xmalloc_atomic((*size_ret) * sizeof(Atom) * 2);
1365                         for (i = 0; i < *size_ret; i++) {
1366                                 if (VECTORP(XVECTOR_DATA(obj)[i])) {
1367                                         Lisp_Object pair = XVECTOR_DATA(obj)[i];
1368                                         if (XVECTOR_LENGTH(pair) != 2) {
1369                                                 signal_error(
1370                                                         Qerror,
1371                                                         list2(build_string(
1372                                                                       tmp_err_2),
1373                                                               pair));
1374                                         }
1375                                         (*(Atom **) data_ret)[i * 2] =
1376                                                 symbol_to_x_atom(
1377                                                         d,
1378                                                         XVECTOR_DATA(pair)[0], 0);
1379                                         (*(Atom **) data_ret)[(i * 2) + 1] =
1380                                                 symbol_to_x_atom(
1381                                                         d,
1382                                                         XVECTOR_DATA(pair)[1], 0);
1383                                 } else {
1384                                         signal_error(Qerror,
1385                                                      list2(build_string(
1386                                                                    tmp_err_3),
1387                                                            obj));
1388                                 }
1389                         }
1390 #endif
1391                 } else {
1392                         /* This vector is an INTEGER set or something like it */
1393                         *size_ret = XVECTOR_LENGTH(obj);
1394                         if (NILP(type)) {
1395                                 type = QINTEGER;
1396                         }
1397                         *format_ret = 16;
1398                         for (i = 0; i < (int)(*size_ret); i++) {
1399                                 if (CONSP(XVECTOR_DATA(obj)[i])) {
1400                                         * format_ret = 32;
1401                                 } else {
1402                                         if (!INTP(XVECTOR_DATA(obj)[i])) {
1403                                                 /* was: Qselection_error */
1404                                                 signal_error(
1405                                                         Qerror,
1406                                                         list2(build_string(
1407                                                                       tmp_err_4),
1408                                                               obj));
1409                                         }
1410                                 }
1411                         }
1412                         *data_ret = xmalloc_atomic(*size_ret *
1413                                                    (*format_ret / 8));
1414                         for (i = 0; i < (int)(*size_ret); i++)
1415                                 if (*format_ret == 32)
1416                                         (*((unsigned long **)data_ret))[i] =
1417                                                 lisp_to_word(XVECTOR_DATA(obj)[i]);
1418                                 else
1419                                         (*((unsigned short **)data_ret))[i] =
1420                                                 (unsigned short) lisp_to_word(XVECTOR_DATA(obj)[i]);
1421                 }
1422         } else {
1423                 signal_error(Qerror,    /* Qselection_error */
1424                              list2(build_string("unrecognized selection data"),
1425                                    obj));
1426         }
1427         *type_ret = symbol_to_x_atom(d, type, 0);
1428 }
1429
1430 \f
1431 /* Called from the event loop to handle SelectionNotify events.
1432    I don't think this needs to be reentrant.
1433 */
1434 void
1435 x_handle_selection_notify(XSelectionEvent * event)
1436 {
1437         if (!reading_selection_reply)
1438                 message("received an unexpected SelectionNotify event");
1439         else if (event->requestor != reading_selection_reply)
1440                 message("received a SelectionNotify event for the wrong window");
1441         else if (event->selection != reading_which_selection)
1442                 message("received the wrong selection type in SelectionNotify!");
1443         else
1444                 reading_selection_reply = 0;    /* we're done now. */
1445 }
1446
1447 static void
1448 x_disown_selection(Lisp_Object selection, Lisp_Object timeval)
1449 {
1450         struct device *d = decode_x_device(Qnil);
1451         Display * display = DEVICE_X_DISPLAY(d);
1452         Time timestamp;
1453         Atom selection_atom;
1454
1455         CHECK_SYMBOL(selection);
1456         if (NILP(timeval))
1457                 timestamp = DEVICE_X_MOUSE_TIMESTAMP(d);
1458         else {
1459                 /* #### This is bogus.  See the comment above about problems
1460                    on OSF/1 and DEC Alphas.  Yet another reason why it sucks
1461                    to have the implementation (i.e. cons of two 16-bit
1462                    integers) exposed. */
1463                 time_t the_time;
1464                 lisp_to_time(timeval, &the_time);
1465                 timestamp = (Time) the_time;
1466         }
1467
1468         selection_atom = symbol_to_x_atom(d, selection, 0);
1469         XSetSelectionOwner(display, selection_atom, None, timestamp);
1470 }
1471
1472 static Lisp_Object
1473 x_selection_exists_p(Lisp_Object selection, Lisp_Object selection_type)
1474 {
1475         struct device *d = decode_x_device(Qnil);
1476         Display * dpy = DEVICE_X_DISPLAY(d);
1477         return XGetSelectionOwner(dpy, symbol_to_x_atom(d, selection, 0)) != None ? Qt : Qnil;
1478 }
1479
1480 \f
1481 #ifdef CUT_BUFFER_SUPPORT
1482
1483 static int cut_buffers_initialized;     /* Whether we're sure they all exist */
1484 /* Ensure that all 8 cut buffers exist.  ICCCM says we gotta... */
1485 static void
1486 initialize_cut_buffers(Display * display, Window window)
1487 {
1488         static unsigned const char *const data = (unsigned const char *)"";
1489 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1490                                     PropModeAppend, data, 0)
1491         FROB(XA_CUT_BUFFER0);
1492         FROB(XA_CUT_BUFFER1);
1493         FROB(XA_CUT_BUFFER2);
1494         FROB(XA_CUT_BUFFER3);
1495         FROB(XA_CUT_BUFFER4);
1496         FROB(XA_CUT_BUFFER5);
1497         FROB(XA_CUT_BUFFER6);
1498         FROB(XA_CUT_BUFFER7);
1499 #undef FROB
1500         cut_buffers_initialized = 1;
1501 }
1502
1503 #define CHECK_CUTBUFFER(symbol) do {                                    \
1504         CHECK_SYMBOL (symbol);                                                  \
1505         if (! (EQ (symbol, QCUT_BUFFER0) ||                                     \
1506                EQ (symbol, QCUT_BUFFER1) ||                                     \
1507                EQ (symbol, QCUT_BUFFER2) ||                                     \
1508                EQ (symbol, QCUT_BUFFER3) ||                                     \
1509                EQ (symbol, QCUT_BUFFER4) ||                                     \
1510                EQ (symbol, QCUT_BUFFER5) ||                                     \
1511                EQ (symbol, QCUT_BUFFER6) ||                                     \
1512                EQ (symbol, QCUT_BUFFER7)))                                      \
1513                 signal_simple_error ("Doesn't name a cutbuffer", symbol);       \
1514 } while (0)
1515
1516 DEFUN("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1517 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1518 */
1519       (cutbuffer))
1520 {
1521         struct device *d = decode_x_device(Qnil);
1522         Display * display = DEVICE_X_DISPLAY(d);
1523         Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1524         Atom cut_buffer_atom;
1525         Extbyte * data;
1526         int bytes;
1527         Atom type;
1528         int format;
1529         unsigned long size;
1530         Lisp_Object ret;
1531
1532         CHECK_CUTBUFFER(cutbuffer);
1533         cut_buffer_atom = symbol_to_x_atom(d, cutbuffer, 0);
1534         x_get_window_property(display, window, cut_buffer_atom, &data,
1535                               &bytes, &type, &format, &size, 0);
1536         if (!data)
1537                 return Qnil;
1538         if (format != 8 || type != XA_STRING)
1539                 signal_simple_error_2("Cut buffer doesn't contain 8-bit STRING data",
1540                                       x_atom_to_symbol(d, type), make_int(format));
1541         /* We cheat - if the string contains an ESC character, that's
1542            technically not allowed in a STRING, so we assume it's
1543            COMPOUND_TEXT that we stored there ourselves earlier,
1544            in x-store-cutbuffer-internal  */
1545         ret = (bytes ? make_ext_string(data, bytes, memchr(data, 0x1b, bytes) ? Qctext : Qbinary) : Qnil);
1546         xfree(data);
1547         return ret;
1548 }
1549
1550 DEFUN("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0,       /*
1551 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1552 */
1553       (cutbuffer, string))
1554 {
1555         struct device *d = decode_x_device(Qnil);
1556         Display * display = DEVICE_X_DISPLAY(d);
1557         Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1558         Atom cut_buffer_atom;
1559         const Bufbyte * data = XSTRING_DATA(string);
1560         Bytecount bytes = XSTRING_LENGTH(string);
1561         Bytecount bytes_remaining;
1562         int max_bytes = SELECTION_QUANTUM(display);
1563 #ifdef MULE
1564         const Bufbyte * ptr, *end;
1565         enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1566 #endif
1567         if (max_bytes > MAX_SELECTION_QUANTUM)
1568                 max_bytes = MAX_SELECTION_QUANTUM;
1569         CHECK_CUTBUFFER(cutbuffer);
1570         CHECK_STRING(string);
1571         cut_buffer_atom =
1572                 symbol_to_x_atom(d, cutbuffer, 0);
1573         if (!cut_buffers_initialized)
1574                 initialize_cut_buffers(display, window);
1575         /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1576            We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1577            The ICCCM requires that this be so, and other clients assume it,
1578            as we do ourselves in initialize_cut_buffers.  */
1579 #ifdef MULE
1580         /* Optimize for the common ASCII case */
1581         for (ptr = data, end = ptr + bytes; ptr <= end;) {
1582                 if (BYTE_ASCII_P(*ptr)) {
1583                         ptr++;
1584                         continue;
1585                 }
1586
1587                 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1
1588                     || (*ptr) == LEADING_BYTE_CONTROL_1) {
1589                         chartypes = LATIN_1;
1590                         ptr += 2;
1591                         continue;
1592                 }
1593
1594                 chartypes = WORLD;
1595                 break;
1596         }
1597
1598         if (chartypes == LATIN_1)
1599                 TO_EXTERNAL_FORMAT(LISP_STRING, string, ALLOCA, (data, bytes), Qbinary);
1600         else if (chartypes == WORLD)
1601                 TO_EXTERNAL_FORMAT(LISP_STRING, string, ALLOCA, (data, bytes), Qctext);
1602 #endif                          /* MULE */
1603         bytes_remaining = bytes;
1604         while (bytes_remaining) {
1605                 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1606                 XChangeProperty(display, window, cut_buffer_atom, XA_STRING, 8,
1607                                 (bytes_remaining == bytes ? PropModeReplace : PropModeAppend),
1608                                 data, chunk);
1609                 data += chunk;
1610                 bytes_remaining -= chunk;
1611         }
1612         return string;
1613 }
1614
1615 DEFUN("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0,   /*
1616 Rotate the values of the cutbuffers by the given number of steps;
1617 positive means move values forward, negative means backward.
1618 */
1619       (n))
1620 {
1621         struct device *d = decode_x_device(Qnil);
1622         Display * display = DEVICE_X_DISPLAY(d);
1623         Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1624         Atom props[8];
1625
1626         CHECK_INT(n);
1627         if (XINT(n) == 0)
1628                 return n;
1629         if (!cut_buffers_initialized)
1630                 initialize_cut_buffers(display, window);
1631         props[0] = XA_CUT_BUFFER0;
1632         props[1] = XA_CUT_BUFFER1;
1633         props[2] = XA_CUT_BUFFER2;
1634         props[3] = XA_CUT_BUFFER3;
1635         props[4] = XA_CUT_BUFFER4;
1636         props[5] = XA_CUT_BUFFER5;
1637         props[6] = XA_CUT_BUFFER6;
1638         props[7] = XA_CUT_BUFFER7;
1639         XRotateWindowProperties(display, window, props, 8, XINT(n));
1640         return n;
1641 }
1642 #endif                          /* CUT_BUFFER_SUPPORT */
1643
1644 \f
1645 /************************************************************************/
1646 /*                            initialization                            */
1647 /************************************************************************/
1648
1649 void
1650 syms_of_select_x(void)
1651 {
1652 #ifdef CUT_BUFFER_SUPPORT
1653         DEFSUBR(Fx_get_cutbuffer_internal);
1654         DEFSUBR(Fx_store_cutbuffer_internal);
1655         DEFSUBR(Fx_rotate_cutbuffers_internal);
1656 #endif                          /* CUT_BUFFER_SUPPORT */
1657         /* Unfortunately, timeout handlers must be lisp functions. */
1658         defsymbol (&Qx_selection_reply_timeout_internal,
1659                    "x-selection-reply-timeout-internal");
1660         DEFSUBR(Fx_selection_reply_timeout_internal);
1661 #ifdef CUT_BUFFER_SUPPORT
1662         defsymbol(&QCUT_BUFFER0, "CUT_BUFFER0");
1663         defsymbol(&QCUT_BUFFER1, "CUT_BUFFER1");
1664         defsymbol(&QCUT_BUFFER2, "CUT_BUFFER2");
1665         defsymbol(&QCUT_BUFFER3, "CUT_BUFFER3");
1666         defsymbol(&QCUT_BUFFER4, "CUT_BUFFER4");
1667         defsymbol(&QCUT_BUFFER5, "CUT_BUFFER5");
1668         defsymbol(&QCUT_BUFFER6, "CUT_BUFFER6");
1669         defsymbol(&QCUT_BUFFER7, "CUT_BUFFER7");
1670 #endif                          /* CUT_BUFFER_SUPPORT */
1671 }
1672
1673 void
1674 console_type_create_select_x(void)
1675 {
1676         CONSOLE_HAS_METHOD(x, own_selection);
1677         CONSOLE_HAS_METHOD(x, disown_selection);
1678         CONSOLE_HAS_METHOD(x, get_foreign_selection);
1679         CONSOLE_HAS_METHOD(x, selection_exists_p);
1680 }
1681
1682 void
1683 reinit_vars_of_select_x(void)
1684 {
1685         reading_selection_reply = 0;
1686         reading_which_selection = 0;
1687         selection_reply_timed_out = 0;
1688         for_whom_the_bell_tolls = 0;
1689         prop_location_tick = 0;
1690 }
1691
1692 void
1693 vars_of_select_x(void)
1694 {
1695         reinit_vars_of_select_x();
1696 #ifdef CUT_BUFFER_SUPPORT
1697         cut_buffers_initialized = 0;
1698         Fprovide(intern("cut-buffer"));
1699 #endif
1700         DEFVAR_LISP("x-sent-selection-hooks", &Vx_sent_selection_hooks  /*
1701 A function or functions to be called after we have responded to some
1702 other client's request for the value of a selection that we own.  The
1703 function(s) will be called with four arguments:
1704   - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1705   - the name of the selection-type which we were requested to convert the
1706     selection into before sending (for example, STRING or LENGTH);
1707   - and whether we successfully transmitted the selection.
1708 We might have failed (and declined the request) for any number of reasons,
1709 including being asked for a selection that we no longer own, or being asked
1710 to convert into a type that we don't know about or that is inappropriate.
1711 This hook doesn't let you change the behavior of emacs's selection replies,
1712 it merely informs you that they have happened.
1713                                                                         */ );
1714         Vx_sent_selection_hooks = Qunbound;
1715
1716         DEFVAR_INT("x-selection-timeout", &x_selection_timeout  /*
1717 If the selection owner doesn't reply in this many seconds, we give up.
1718 A value of 0 means wait as long as necessary.  This is initialized from the
1719 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1720                                                                 */ );
1721         x_selection_timeout = 0;
1722
1723         DEFVAR_BOOL("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership   /*
1724 *If nil and SXEmacs already owns the clipboard, don't own it again in the
1725 Motif way. Owning the selection on the Motif way does a huge amount of
1726 X protocol, and it makes killing text incredibly slow when using an
1727 X terminal.  However, when enabled Motif text fields don't bother to look up
1728 the new value, and you can't Copy from a buffer, Paste into a text
1729 field, then Copy something else from the buffer and paste it into the
1730 text field; it pastes the first thing again.
1731                                                                                                 */ );
1732         x_selection_strict_motif_ownership = 1;
1733 }
1734
1735 void
1736 Xatoms_of_select_x(struct device *d)
1737 {
1738         Display * D = DEVICE_X_DISPLAY(d);
1739         /* Non-predefined atoms that we might end up using a lot */
1740         DEVICE_XATOM_CLIPBOARD(d) =
1741                 XInternAtom(D, "CLIPBOARD", False);
1742         DEVICE_XATOM_TIMESTAMP(d) =
1743                 XInternAtom(D, "TIMESTAMP", False);
1744         DEVICE_XATOM_TEXT(d) =
1745                 XInternAtom(D, "TEXT", False);
1746         DEVICE_XATOM_DELETE(d) =
1747                 XInternAtom(D, "DELETE", False);
1748         DEVICE_XATOM_MULTIPLE(d) =
1749                 XInternAtom(D, "MULTIPLE", False);
1750         DEVICE_XATOM_INCR(d) =
1751                 XInternAtom(D, "INCR", False);
1752         DEVICE_XATOM_TARGETS(d) =
1753                 XInternAtom(D, "TARGETS", False);
1754         DEVICE_XATOM_NULL(d) =
1755                 XInternAtom(D, "NULL", False);
1756         DEVICE_XATOM_ATOM_PAIR(d) =
1757                 XInternAtom(D, "ATOM_PAIR", False);
1758         DEVICE_XATOM_COMPOUND_TEXT(d) =
1759                 XInternAtom(D, "COMPOUND_TEXT", False);
1760         /* #### I don't like the looks of this... what is it for? - ajh */
1761         DEVICE_XATOM_EMACS_TMP(d) =
1762                 XInternAtom(D, "_EMACS_TMP_", False);
1763 }