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