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