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