src/select.c

   1 /* Generic selection processing for XEmacs
   2    Copyright (C) 1999 Free Software Foundation, Inc.
   3    Copyright (C) 1999 Andy Piper.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Not synched with FSF. */
  23
  24 #include <config.h>
  25 #include "lisp.h"
  26
  27 #include "buffer.h"
  28 #include "device.h"
  29 #include "extents.h"
  30 #include "console.h"
  31 #include "objects.h"
  32
  33 #include "frame.h"
  34 #include "opaque.h"
  35 #include "select.h"
  36
  37 /* X Atoms */
  38 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  39   QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  40   QATOM_PAIR, QCOMPOUND_TEXT;
  41
  42 /* Windows clipboard formats */
  43 Lisp_Object QCF_TEXT, QCF_BITMAP, QCF_METAFILEPICT, QCF_SYLK, QCF_DIF,
  44   QCF_TIFF, QCF_OEMTEXT, QCF_DIB, QCF_DIBV5, QCF_PALETTE, QCF_PENDATA,
  45   QCF_RIFF, QCF_WAVE, QCF_UNICODETEXT, QCF_ENHMETAFILE, QCF_HDROP, QCF_LOCALE,
  46   QCF_OWNERDISPLAY, QCF_DSPTEXT, QCF_DSPBITMAP, QCF_DSPMETAFILEPICT,
  47   QCF_DSPENHMETAFILE;
  48
  49 /* Selection strategy symbols */
  50 Lisp_Object Qreplace_all, Qreplace_existing;
  51
  52 /* "Selection owner couldn't convert selection" */
  53 Lisp_Object Qselection_conversion_error;
  54
  55 /* A couple of Lisp functions */
  56 Lisp_Object Qselect_convert_in, Qselect_convert_out, Qselect_coerce;
  57
  58 /* These are alists whose CARs are selection-types (whose names are the same
  59    as the names of X Atoms or Windows clipboard formats) and whose CDRs are
  60    the names of Lisp functions to call to convert the given Emacs selection
  61    value to a string representing the given selection type.  This is for
  62    elisp-level extension of the emacs selection handling.
  63  */
  64 Lisp_Object Vselection_converter_out_alist;
  65 Lisp_Object Vselection_converter_in_alist;
  66 Lisp_Object Vselection_coercion_alist;
  67 Lisp_Object Vselection_appender_alist;
  68 Lisp_Object Vselection_buffer_killed_alist;
  69 Lisp_Object Vselection_coercible_types;
  70
  71 Lisp_Object Vlost_selection_hooks;
  72
  73 /* This is an association list whose elements are of the form
  74      ( selection-name selection-value selection-timestamp )
  75    selection-name is a lisp symbol, whose name is the name of an X Atom.
  76    selection-value is a list of cons pairs that emacs owns for that selection.
  77      Each pair consists of (type . value), where type is nil or a
  78      selection data type, and value is any type of Lisp object.
  79    selection-timestamp is the time at which emacs began owning this selection,
  80      as a cons of two 16-bit numbers (making a 32 bit time).
  81    If there is an entry in this alist, then it can be assumed that emacs owns
  82     that selection.
  83    The only (eq) parts of this list that are visible from elisp are the
  84     selection-values.
  85  */
  86 Lisp_Object Vselection_alist;
  87
  88 /* Given a selection-name and desired type, this looks up our local copy of
  89    the selection value and converts it to the type. */
  90 static Lisp_Object
  91 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
  92 {
  93   Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
  94
  95   if (!NILP (local_value))
  96     {
  97       Lisp_Object value_list = XCAR (XCDR (local_value));
  98       Lisp_Object value;
  99
 100       /* First try to find an entry of the appropriate type */
 101       value = assq_no_quit (target_type, value_list);
 102
 103       if (!NILP (value))
 104         return XCDR (value);
 105     }
 106
 107   return Qnil;
 108 }
 109
 110 /* #### Should perhaps handle 'MULTIPLE. The code below is now completely
 111    broken due to a re-organization of get_local_selection, but I've left
 112    it here should anyone show an interest - ajh */
 113 #if 0
 114       else if (CONSP (target_type) &&
 115                XCAR (target_type) == QMULTIPLE)
 116         {
 117           Lisp_Object pairs = XCDR (target_type);
 118           int len = XVECTOR_LENGTH (pairs);
 119           int i;
 120           /* If the target is MULTIPLE, then target_type looks like
 121              (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
 122              We modify the second element of each pair in the vector and
 123              return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
 124           */
 125           for (i = 0; i < len; i++)
 126             {
 127               Lisp_Object pair = XVECTOR_DATA (pairs) [i];
 128               XVECTOR_DATA (pair) [1] =
 129                 x_get_local_selection (XVECTOR_DATA (pair) [0],
 130                                        XVECTOR_DATA (pair) [1]);
 131             }
 132           return pairs;
 133         }
 134 #endif
 135
 136 DEFUN ("own-selection-internal", Fown_selection_internal, 2, 5, 0, /*
 137 Give the selection SELECTION-NAME the value SELECTION-VALUE.
 138 SELECTION-NAME is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 139 SELECTION-VALUE is typically a string, or a cons of two markers, but may be
 140 anything that the functions on selection-converter-out-alist know about.
 141 Optional arg HOW-TO-ADD specifies how the selection will be combined
 142 with any existing selection(s) - see `own-selection' for more
 143 information.
 144 Optional arg DATA-TYPE is a window-system-specific type.
 145 Optional arg DEVICE specifies the device on which to assert the selection.
 146 It defaults to the selected device.
 147 */
 148        (selection_name, selection_value, how_to_add, data_type, device))
 149 {
 150   Lisp_Object selection_time, selection_data, prev_value = Qnil,
 151     value_list = Qnil;
 152   Lisp_Object prev_real_value = Qnil;
 153   struct gcpro gcpro1;
 154   int owned_p = 0;
 155
 156   CHECK_SYMBOL (selection_name);
 157   if (NILP (selection_value)) error ("selection-value may not be nil.");
 158
 159   if (NILP (device))
 160     device = Fselected_device (Qnil);
 161
 162   if (!EQ (how_to_add, Qappend) && !EQ (how_to_add, Qt)
 163       && !EQ (how_to_add, Qreplace_existing)
 164       && !EQ (how_to_add, Qreplace_all) && !NILP (how_to_add))
 165     error ("how-to-add must be nil, append, replace_all, "
 166            "replace_existing or t.");
 167
 168 #ifdef MULE
 169   if (NILP (data_type))
 170     data_type = QCOMPOUND_TEXT;
 171 #else
 172   if (NILP (data_type))
 173     data_type = QSTRING;
 174 #endif
 175
 176   /* Examine the how-to-add argument */
 177   if (EQ (how_to_add, Qreplace_all) || NILP (how_to_add))
 178     {
 179       Lisp_Object local_selection_data = assq_no_quit (selection_name,
 180                                                        Vselection_alist);
 181
 182       if (!NILP (local_selection_data))
 183         {
 184           owned_p = 1;
 185           /* Don't use Fdelq() as that may QUIT;. */
 186           if (EQ (local_selection_data, Fcar (Vselection_alist)))
 187             Vselection_alist = Fcdr (Vselection_alist);
 188           else
 189             {
 190               Lisp_Object rest;
 191               for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 192                 if (EQ (local_selection_data, Fcar (XCDR (rest))))
 193                   {
 194                     XCDR (rest) = Fcdr (XCDR (rest));
 195                     break;
 196                   }
 197             }
 198         }
 199     }
 200   else
 201     {
 202       /* Look for a previous value */
 203       prev_value = assq_no_quit (selection_name, Vselection_alist);
 204
 205       if (!NILP (prev_value))
 206         {
 207           owned_p = 1;
 208           value_list = XCAR (XCDR (prev_value));
 209         }
 210
 211       if (!NILP (value_list))
 212         prev_real_value = assq_no_quit (data_type, value_list);
 213     }
 214
 215   /* Append values if necessary */
 216   if (!NILP (value_list) && (EQ (how_to_add, Qappend) || EQ (how_to_add, Qt)))
 217     {
 218       /* Did we have anything of this type previously? */
 219       if (!NILP (prev_real_value))
 220         {
 221           if ((NILP (data_type) && STRINGP (selection_value)
 222                && STRINGP (XCDR (prev_real_value)))
 223               || !NILP (data_type))
 224             {
 225               Lisp_Object function = assq_no_quit (data_type,
 226                                                    Vselection_appender_alist);
 227
 228               if (NILP (function))
 229                 error ("cannot append selections of supplied types.");
 230
 231               function = XCDR (function);
 232
 233               selection_value = call4 (function,
 234                                        selection_name,
 235                                        data_type,
 236                                        XCDR (prev_real_value),
 237                                        selection_value);
 238
 239               if (NILP (selection_value))
 240                 error ("cannot append selections of supplied types.");
 241             }
 242           else
 243             error ("cannot append selections of supplied types.");
 244         }
 245
 246       selection_data = Fcons (data_type, selection_value);
 247       value_list = Fcons (selection_data, value_list);
 248     }
 249
 250   if (!NILP (prev_real_value))
 251     {
 252       Lisp_Object rest; /* We know it isn't the CAR, so it's easy. */
 253
 254       /* Delete the old type entry from the list */
 255       for (rest = value_list; !NILP (rest); rest = Fcdr (rest))
 256         if (EQ (prev_real_value, Fcar (XCDR (rest))))
 257           {
 258             XCDR (rest) = Fcdr (XCDR (rest));
 259             break;
 260           }
 261     }
 262   else
 263     {
 264       value_list = Fcons (Fcons (data_type, selection_value),
 265                           value_list);
 266     }
 267
 268   /* Complete the local cache update; note that we destructively
 269      modify the current list entry if there is one */
 270   if (NILP (prev_value))
 271     {
 272       selection_data = list3 (selection_name, value_list, Qnil);
 273       Vselection_alist = Fcons (selection_data, Vselection_alist);
 274     }
 275   else
 276     {
 277       selection_data = prev_value;
 278       Fsetcar (XCDR (selection_data), value_list);
 279     }
 280
 281   GCPRO1 (selection_data);
 282
 283   /* have to do device specific stuff last so that methods can access the
 284      selection_alist */
 285   if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
 286     selection_time = DEVMETH (XDEVICE (device), own_selection,
 287                               (selection_name, selection_value,
 288                                how_to_add, data_type, owned_p));
 289   else
 290     selection_time = Qnil;
 291
 292   Fsetcar (XCDR (XCDR (selection_data)), selection_time);
 293
 294   UNGCPRO;
 295
 296   return selection_value;
 297 }
 298
 299 DEFUN ("register-selection-data-type", Fregister_selection_data_type, 1,2,0, /*
 300 Register a new selection data type DATA-TYPE, optionally on the specified
 301 DEVICE. Returns the device-specific data type identifier, or nil if the
 302 device does not support this feature or the registration fails. */
 303        (data_type, device))
 304 {
 305   /* Check arguments */
 306   CHECK_STRING (data_type);
 307
 308   if (NILP (device))
 309     device = Fselected_device (Qnil);
 310
 311   if (HAS_DEVMETH_P (XDEVICE (device), register_selection_data_type))
 312     return DEVMETH (XDEVICE (device), register_selection_data_type,
 313                     (data_type));
 314   else
 315     return Qnil;
 316 }
 317
 318 DEFUN ("selection-data-type-name", Fselection_data_type_name, 1, 2, 0, /*
 319 Retrieve the name of the specified selection data type DATA-TYPE, optionally
 320 on the specified DEVICE. Returns either a string or a symbol on success, and
 321 nil if the device does not support this feature or the type is not known. */
 322        (data_type, device))
 323 {
 324   if (NILP (device))
 325     device = Fselected_device (Qnil);
 326
 327   if (HAS_DEVMETH_P (XDEVICE (device), selection_data_type_name))
 328     return DEVMETH (XDEVICE (device), selection_data_type_name, (data_type));
 329   else
 330     return Qnil;
 331 }
 332
 333 DEFUN ("available-selection-types", Favailable_selection_types, 1, 2, 0, /*
 334 Retrieve a list of currently available types of selection associated with
 335 the given SELECTION-NAME, optionally on the specified DEVICE. This list
 336 does not take into account any possible conversions that might take place,
 337 so it should be taken as a minimal estimate of what is available.
 338 */
 339        (selection_name, device))
 340 {
 341   Lisp_Object types = Qnil, rest;
 342   struct gcpro gcpro1;
 343
 344   CHECK_SYMBOL (selection_name);
 345
 346   if (NILP (device))
 347     device = Fselected_device (Qnil);
 348
 349   GCPRO1 (types);
 350
 351   /* First check the device */
 352   if (HAS_DEVMETH_P (XDEVICE (device), available_selection_types))
 353     types = DEVMETH (XDEVICE (device), available_selection_types,
 354                      (selection_name));
 355
 356   /* Now look in the list */
 357   rest = assq_no_quit (selection_name, Vselection_alist);
 358
 359   if (NILP (rest))
 360     {
 361       UNGCPRO;
 362
 363       return types;
 364     }
 365
 366   /* Examine the types and cons them onto the front of the list */
 367   for (rest = XCAR (XCDR (rest)); !NILP (rest); rest = XCDR (rest))
 368     {
 369       Lisp_Object value = XCDR (XCAR (rest));
 370       Lisp_Object type = XCAR (XCAR (rest));
 371
 372       types = Fcons (type, types);
 373
 374       if ((STRINGP (value) || EXTENTP (value))
 375           && (NILP (type) || EQ (type, QSTRING)
 376               || EQ (type, QTEXT) || EQ (type, QCOMPOUND_TEXT)))
 377         types = Fcons (QTEXT, Fcons (QCOMPOUND_TEXT, Fcons (QSTRING, types)));
 378       else if (INTP (value) && NILP (type))
 379         types = Fcons (QINTEGER, types);
 380       else if (SYMBOLP (value) && NILP (type))
 381         types = Fcons (QATOM, types);
 382     }
 383
 384   UNGCPRO;
 385
 386   return types;
 387 }
 388
 389 /* remove a selection from our local copy
 390  */
 391 void
 392 handle_selection_clear (Lisp_Object selection_symbol)
 393 {
 394   Lisp_Object local_selection_data = assq_no_quit (selection_symbol,
 395                                                    Vselection_alist);
 396
 397   /* Well, we already believe that we don't own it, so that's just fine. */
 398   if (NILP (local_selection_data)) return;
 399
 400   /* Otherwise, we're really honest and truly being told to drop it.
 401      Don't use Fdelq() as that may QUIT;.
 402    */
 403   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 404     Vselection_alist = Fcdr (Vselection_alist);
 405   else
 406     {
 407       Lisp_Object rest;
 408       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 409         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 410           {
 411             XCDR (rest) = Fcdr (XCDR (rest));
 412             break;
 413           }
 414     }
 415
 416   /* Let random lisp code notice that the selection has been stolen.
 417    */
 418   {
 419     Lisp_Object rest;
 420     Lisp_Object val = Vlost_selection_hooks;
 421     if (!UNBOUNDP (val) && !NILP (val))
 422       {
 423         if (CONSP (val) && !EQ (XCAR (val), Qlambda))
 424           for (rest = val; !NILP (rest); rest = Fcdr (rest))
 425             call1 (Fcar (rest), selection_symbol);
 426         else
 427           call1 (val, selection_symbol);
 428       }
 429   }
 430 }
 431
 432 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
 433 If we own the named selection, then disown it (make there be no selection).
 434 */
 435        (selection_name, selection_time, device))
 436 {
 437   if (NILP (assq_no_quit (selection_name, Vselection_alist)))
 438     return Qnil;  /* Don't disown the selection when we're not the owner. */
 439
 440   if (NILP (device))
 441     device = Fselected_device (Qnil);
 442
 443   MAYBE_DEVMETH (XDEVICE (device), disown_selection,
 444                  (selection_name, selection_time));
 445
 446   handle_selection_clear (selection_name);
 447
 448   return Qt;
 449 }
 450
 451 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
 452 Return t if the current emacs process owns SELECTION.
 453 SELECTION should be the name of the selection in question, typically one of
 454 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 455 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 456 */
 457        (selection))
 458 {
 459   CHECK_SYMBOL (selection);
 460   if      (EQ (selection, Qnil)) selection = QPRIMARY;
 461   else if (EQ (selection, Qt))   selection = QSECONDARY;
 462
 463   return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
 464 }
 465
 466 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 3, 0, /*
 467 Whether there is currently an owner for SELECTION.
 468 SELECTION should be the name of the selection in question, typically one of
 469 the symbols PRIMARY, SECONDARY, or CLIPBOARD.  (For convenience, the symbol
 470 nil is the same as PRIMARY, and t is the same as SECONDARY.)
 471 Optionally, the window-system DATA-TYPE and the DEVICE may be specified.
 472 */
 473        (selection, data_type, device))
 474 {
 475   CHECK_SYMBOL (selection);
 476   if (NILP (data_type)
 477       && !NILP (Fselection_owner_p (selection)))
 478     return Qt;
 479
 480   if (NILP (device))
 481     device = Fselected_device (Qnil);
 482
 483   return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
 484     DEVMETH (XDEVICE (device), selection_exists_p, (selection, data_type))
 485     : Qnil;
 486 }
 487
 488 /* Get the timestamp of the given selection */
 489 DEFUN ("get-selection-timestamp", Fget_selection_timestamp, 1, 1, 0, /*
 490 Return the timestamp associated with the specified SELECTION, if it exists.
 491 Note that the timestamp is a device-specific object, and may not actually be
 492 visible from Lisp.
 493 */
 494        (selection))
 495 {
 496   Lisp_Object local_value = assq_no_quit (selection, Vselection_alist);
 497
 498   if (!NILP (local_value))
 499     return XCAR (XCDR (XCDR (local_value)));
 500
 501   return Qnil;
 502 }
 503
 504 /* Request the selection value from the owner.  If we are the owner,
 505    simply return our selection value.  If we are not the owner, this
 506    will block until all of the data has arrived.
 507  */
 508 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
 509 Return text selected from some window-system window.
 510 SELECTION is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
 511 TARGET-TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
 512 Under Mule, if the resultant data comes back as 8-bit data in type
 513 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
 514 */
 515        (selection, target_type, device))
 516 {
 517   /* This function can GC */
 518   Lisp_Object val = Qnil;
 519   struct gcpro gcpro1, gcpro2;
 520   GCPRO2 (target_type, val);
 521   CHECK_SYMBOL (selection);
 522
 523   if (NILP (device))
 524     device = Fselected_device (Qnil);
 525
 526 #ifdef MULE
 527   if (NILP (target_type))
 528     target_type = QCOMPOUND_TEXT;
 529 #else
 530   if (NILP (target_type))
 531     target_type = QSTRING;
 532 #endif
 533
 534 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
 535   if (CONSP (target_type) &&
 536       XCAR (target_type) == QMULTIPLE)
 537     {
 538       CHECK_VECTOR (XCDR (target_type));
 539       /* So we don't destructively modify this... */
 540       target_type = copy_multiple_data (target_type);
 541     }
 542 #endif
 543
 544   /* Used to check that target_type was a symbol. This is no longer
 545      necessarily the case, because the type might be registered with
 546      the device (in which case target_type would be a device-specific
 547      identifier - probably an integer) - ajh */
 548
 549   val = get_local_selection (selection, target_type);
 550
 551   if (!NILP (val))
 552     {
 553       /* If we get something from the local cache, we may need to convert
 554          it slightly - to do this, we call select-coerce */
 555       val = call3 (Qselect_coerce, selection, target_type, val);
 556     }
 557   else if (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection))
 558     {
 559       /* Nothing in the local cache; try the window system */
 560       val = DEVMETH (XDEVICE (device), get_foreign_selection,
 561                      (selection, target_type));
 562     }
 563
 564   if (NILP (val))
 565     {
 566       /* Still nothing. Try coercion. */
 567
 568       /* Try looking in selection-coercible-types to see if any of
 569          them are present for this selection. We try them *in order*;
 570          the first for which a conversion succeeds gets returned. */
 571       EXTERNAL_LIST_LOOP_2 (element, Vselection_coercible_types)
 572         {
 573           val = get_local_selection (selection, element);
 574
 575           if (NILP (val))
 576             continue;
 577
 578           val = call3 (Qselect_coerce, selection, target_type, val);
 579
 580           if (!NILP (val))
 581             break;
 582         }
 583     }
 584
 585   /* Used to call clean_local_selection here... but that really belonged
 586      in Lisp (so the equivalent is now built-in to the INTEGER conversion
 587      function select-convert-from-integer) - ajh */
 588
 589   UNGCPRO;
 590   return val;
 591 }
 592
 593 /* These are convenient interfaces to the lisp code in select.el;
 594    this way we can rename them easily rather than having to hunt everywhere.
 595    Also, this gives us access to get_local_selection so that convert_out
 596    can retrieve the internal selection value automatically if passed a
 597    value of Qnil. */
 598 Lisp_Object
 599 select_convert_in (Lisp_Object selection,
 600                    Lisp_Object type,
 601                    Lisp_Object value)
 602 {
 603   return call3 (Qselect_convert_in, selection, type, value);
 604 }
 605
 606 Lisp_Object
 607 select_coerce (Lisp_Object selection,
 608                Lisp_Object type,
 609                Lisp_Object value)
 610 {
 611   return call3 (Qselect_coerce, selection, type, value);
 612 }
 613
 614 Lisp_Object
 615 select_convert_out (Lisp_Object selection,
 616                     Lisp_Object type,
 617                     Lisp_Object value)
 618 {
 619   if (NILP (value))
 620     value = get_local_selection (selection, type);
 621
 622   if (NILP (value))
 623     {
 624       /* Try looking in selection-coercible-types to see if any of
 625          them are present for this selection. We try them *in order*;
 626          the first for which a conversion succeeds gets returned. */
 627       EXTERNAL_LIST_LOOP_2 (element, Vselection_coercible_types)
 628         {
 629           Lisp_Object ret;
 630
 631           value = get_local_selection (selection, element);
 632
 633           if (NILP (value))
 634             continue;
 635
 636           ret = call3 (Qselect_convert_out, selection, type, value);
 637
 638           if (!NILP (ret))
 639             return ret;
 640         }
 641
 642       return Qnil;
 643     }
 644
 645   return call3 (Qselect_convert_out, selection, type, value);
 646 }
 647
 648 \f
 649 /* Gets called from kill-buffer; this lets us dispose of buffer-dependent
 650    selections (or alternatively make them independent of the buffer) when
 651    it gets vaped. */
 652 void
 653 select_notify_buffer_kill (Lisp_Object buffer)
 654 {
 655   Lisp_Object rest;
 656   struct gcpro gcpro1, gcpro2, gcpro3;
 657
 658   /* For each element of Vselection_alist */
 659   for (rest = Vselection_alist;
 660        !NILP (rest);)
 661     {
 662       Lisp_Object selection, values, prev = Qnil;
 663
 664       selection = XCAR (rest);
 665
 666       for (values = XCAR (XCDR (selection));
 667            !NILP (values);
 668            values = XCDR (values))
 669         {
 670           Lisp_Object value, handler_fn;
 671
 672           /* Extract the (type . value) pair. */
 673           value = XCAR (values);
 674
 675           /* Find the handler function (if any). */
 676           handler_fn = Fcdr (Fassq (XCAR (value),
 677                                     Vselection_buffer_killed_alist));
 678
 679           if (!NILP (handler_fn))
 680             {
 681               Lisp_Object newval;
 682
 683               /* Protect ourselves, just in case some tomfool calls
 684                  own-selection from with the buffer-killed handler, then
 685                  causes a GC. Just as a note, *don't do this*. */
 686               GCPRO3 (rest, values, value);
 687
 688               newval = call4 (handler_fn, XCAR (selection), XCAR (value),
 689                               XCDR (value), buffer);
 690
 691               UNGCPRO;
 692
 693               /* Set or delete the value (by destructively modifying
 694                  the list). */
 695               if (!NILP (newval))
 696                 {
 697                   Fsetcdr (value, newval);
 698
 699                   prev = values;
 700                 }
 701               else
 702                 {
 703                   if (NILP (prev))
 704                     Fsetcar (XCDR (selection), XCDR (values));
 705                   else
 706                     Fsetcdr (prev, XCDR (values));
 707                 }
 708             }
 709           else
 710             prev = values;
 711         }
 712
 713       /* If we have no values for this selection */
 714       if (NILP (XCAR (XCDR (selection))))
 715         {
 716           /* Move on to the next element *first* */
 717           rest = XCDR (rest);
 718
 719           /* Protect it and disown this selection */
 720           GCPRO1 (rest);
 721
 722           Fdisown_selection_internal (XCAR (selection), Qnil, Qnil);
 723
 724           UNGCPRO;
 725         }
 726       else
 727         rest = XCDR (rest);
 728     }
 729 }
 730
 731 \f
 732 void
 733 syms_of_select (void)
 734 {
 735   DEFSUBR (Fown_selection_internal);
 736   DEFSUBR (Fget_selection_internal);
 737   DEFSUBR (Fget_selection_timestamp);
 738   DEFSUBR (Fselection_exists_p);
 739   DEFSUBR (Fdisown_selection_internal);
 740   DEFSUBR (Fselection_owner_p);
 741   DEFSUBR (Favailable_selection_types);
 742   DEFSUBR (Fregister_selection_data_type);
 743   DEFSUBR (Fselection_data_type_name);
 744
 745   /* Lisp Functions */
 746   defsymbol (&Qselect_convert_in, "select-convert-in");
 747   defsymbol (&Qselect_convert_out, "select-convert-out");
 748   defsymbol (&Qselect_coerce, "select-coerce");
 749
 750   /* X Atoms */
 751   defsymbol (&QPRIMARY, "PRIMARY");
 752   defsymbol (&QSECONDARY, "SECONDARY");
 753   defsymbol (&QSTRING, "STRING");
 754   defsymbol (&QINTEGER, "INTEGER");
 755   defsymbol (&QCLIPBOARD, "CLIPBOARD");
 756   defsymbol (&QTIMESTAMP, "TIMESTAMP");
 757   defsymbol (&QTEXT, "TEXT");
 758   defsymbol (&QDELETE, "DELETE");
 759   defsymbol (&QMULTIPLE, "MULTIPLE");
 760   defsymbol (&QINCR, "INCR");
 761   defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
 762   defsymbol (&QTARGETS, "TARGETS");
 763   defsymbol (&QATOM, "ATOM");
 764   defsymbol (&QATOM_PAIR, "ATOM_PAIR");
 765   defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
 766   defsymbol (&QNULL, "NULL");
 767
 768   /* Windows formats - these all start with CF_ */
 769   defsymbol (&QCF_TEXT, "CF_TEXT");
 770   defsymbol (&QCF_BITMAP, "CF_BITMAP");
 771   defsymbol (&QCF_METAFILEPICT, "CF_METAFILEPICT");
 772   defsymbol (&QCF_SYLK, "CF_SYLK");
 773   defsymbol (&QCF_DIF, "CF_DIF");
 774   defsymbol (&QCF_TIFF, "CF_TIFF");
 775   defsymbol (&QCF_OEMTEXT, "CF_OEMTEXT");
 776   defsymbol (&QCF_DIB, "CF_DIB");
 777   defsymbol (&QCF_DIBV5, "CF_DIBV5");
 778   defsymbol (&QCF_PALETTE, "CF_PALETTE");
 779   defsymbol (&QCF_PENDATA, "CF_PENDATA");
 780   defsymbol (&QCF_RIFF, "CF_RIFF");
 781   defsymbol (&QCF_WAVE, "CF_WAVE");
 782   defsymbol (&QCF_UNICODETEXT, "CF_UNICODETEXT");
 783   defsymbol (&QCF_ENHMETAFILE, "CF_ENHMETAFILE");
 784   defsymbol (&QCF_HDROP, "CF_HDROP");
 785   defsymbol (&QCF_LOCALE, "CF_LOCALE");
 786   defsymbol (&QCF_OWNERDISPLAY, "CF_OWNERDISPLAY");
 787   defsymbol (&QCF_DSPTEXT, "CF_DSPTEXT");
 788   defsymbol (&QCF_DSPBITMAP, "CF_DSPBITMAP");
 789   defsymbol (&QCF_DSPMETAFILEPICT, "CF_DSPMETAFILEPICT");
 790   defsymbol (&QCF_DSPENHMETAFILE, "CF_DSPENHMETAFILE");
 791
 792   /* Selection strategies */
 793   defsymbol (&Qreplace_all, "replace-all");
 794   defsymbol (&Qreplace_existing, "replace-existing");
 795
 796   DEFERROR_STANDARD (Qselection_conversion_error, Qio_error);
 797 }
 798
 799 void
 800 vars_of_select (void)
 801 {
 802   Vselection_alist = Qnil;
 803   staticpro (&Vselection_alist);
 804
 805   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_out_alist /*
 806 An alist associating selection-types (such as STRING and TIMESTAMP) with
 807 functions.  This is an alias for `selection-converter-out-alist', and should
 808 be considered obsolete.  Use the new name instead. */ );
 809
 810   DEFVAR_LISP ("selection-converter-out-alist",
 811                &Vselection_converter_out_alist /*
 812 An alist associating selection-types (such as STRING and TIMESTAMP) with
 813 functions.  These functions will be called with three args: the name
 814 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
 815 desired type to which the selection should be converted; and the local
 816 selection value (whatever had been passed to `own-selection').
 817
 818 The return type of these functions depends upon the device in question;
 819 for mswindows, a string should be returned containing data in the requested
 820 format, or nil to indicate that the conversion could not be done.  Additionally,
 821 it is permissible to return a cons of the form (DATA-TYPE . STRING) suggesting
 822 a new data type to use instead.
 823
 824 For X, the return value should be one of:
 825
 826 -- nil (the conversion could not be done)
 827 -- a cons of a symbol and any of the following values; the symbol
 828    explicitly specifies the type that will be sent.
 829 -- a string (If the type is not specified, then if Mule support exists,
 830              the string will be converted to Compound Text and sent in
 831              the 'COMPOUND_TEXT format; otherwise (no Mule support),
 832              the string will be left as-is and sent in the 'STRING
 833              format.  If the type is specified, the string will be
 834              left as-is (or converted to binary format under Mule).
 835              In all cases, 8-bit data it sent.)
 836 -- a character (With Mule support, will be converted to Compound Text
 837                 whether or not a type is specified.  If a type is not
 838                 specified, a type of 'STRING or 'COMPOUND_TEXT will be
 839                 sent, as for strings.)
 840 -- the symbol 'NULL (Indicates that there is no meaningful return value.
 841                      Empty 32-bit data with a type of 'NULL will be sent.)
 842 -- a symbol (Will be converted into an atom.  If the type is not specified,
 843              a type of 'ATOM will be sent.)
 844 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
 845                on the value.  If the type is not specified, a type of
 846                'INTEGER will be sent.)
 847 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
 848                                     If the type is not specified, a type of
 849                                     'INTEGER will be sent.)
 850 -- a vector of symbols (Will be converted into a list of atoms.  If the type
 851                         is not specified, a type of 'ATOM will be sent.)
 852 -- a vector of integers (Will be converted into a list of 16-bit integers.
 853                          If the type is not specified, a type of 'INTEGER
 854                          will be sent.)
 855 -- a vector of integers and/or conses (HIGH . LOW) of integers
 856                         (Will be converted into a list of 16-bit integers.
 857                          If the type is not specified, a type of 'INTEGER
 858                          will be sent.)
 859 */ );
 860   Vselection_converter_out_alist = Qnil;
 861
 862   DEFVAR_LISP ("selection-converter-in-alist",
 863                &Vselection_converter_in_alist /*
 864 An alist associating selection-types (such as STRING and TIMESTAMP) with
 865 functions.  These functions will be called with three args: the name
 866 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the
 867 type from which the selection should be converted; and the selection
 868 value.  These functions should return a suitable representation of the
 869 value, or nil to indicate that the conversion was not possible.
 870
 871 See also `selection-converter-out-alist'. */ );
 872   Vselection_converter_in_alist = Qnil;
 873
 874   DEFVAR_LISP ("selection-coercion-alist",
 875                &Vselection_coercion_alist /*
 876 An alist associating selection-types (such as STRING and TIMESTAMP) with
 877 functions.  These functions will be called with three args; the name
 878 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the type
 879 from which the selection should be converted, and the selection value.
 880 The value passed will be *exactly the same value* that was given to
 881 `own-selection'; it should be converted into something suitable for
 882 return to a program calling `get-selection' with the appropriate
 883 parameters.
 884
 885 See also `selection-converter-in-alist' and
 886 `selection-converter-out-alist'. */);
 887   Vselection_coercion_alist = Qnil;
 888
 889   DEFVAR_LISP ("selection-appender-alist",
 890                &Vselection_appender_alist /*
 891 An alist associating selection-types (such as STRING and TIMESTAMP) with
 892 functions.  These functions will be called with four args; the name
 893 of the selection (typically PRIMARY, SECONDARY or CLIPBOARD); the type
 894 of the selection; and two selection values.  The functions are expected to
 895 return a value representing the catenation of the two values, or nil to
 896 indicate that this was not possible. */ );
 897   Vselection_appender_alist = Qnil;
 898
 899   DEFVAR_LISP ("selection-buffer-killed-alist",
 900                &Vselection_buffer_killed_alist /*
 901 An alist associating selection-types (such as STRING and TIMESTAMP) with
 902 functions.  These functions will be called whenever a buffer is killed,
 903 with four args: the name of the selection (typically PRIMARY, SECONDARY
 904 or CLIPBOARD); the type of the selection; the value of the selection; and
 905 the buffer that has just been killed.  These functions should return a new
 906 selection value, or nil to indicate that the selection value should be
 907 deleted. */ );
 908   Vselection_buffer_killed_alist = Qnil;
 909
 910   DEFVAR_LISP ("selection-coercible-types",
 911                &Vselection_coercible_types /*
 912 A list of selection types that are coercible---that is, types that may be
 913 automatically converted to another type. Selection values with types in this
 914 list may be subject to conversion attempts to other types. */ );
 915   Vselection_coercible_types = Qnil;
 916
 917   DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
 918 A function or functions to be called after we have been notified
 919 that we have lost the selection.  The function(s) will be called with one
 920 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
 921 CLIPBOARD).
 922 */ );
 923   Vlost_selection_hooks = Qunbound;
 924 }