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