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

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