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"
|
|
28 #include "device.h"
|
|
29 #include "console.h"
|
|
30 #include "objects.h"
|
|
31
|
|
32 #include "frame.h"
|
|
33 #include "opaque.h"
|
|
34 #include "select.h"
|
|
35
|
|
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
|
|
40 /* "Selection owner couldn't convert selection" */
|
|
41 Lisp_Object Qselection_conversion_error;
|
|
42
|
|
43 /* This is an alist whose CARs are selection-types (whose names are the same
|
|
44 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
|
|
45 call to convert the given Emacs selection value to a string representing
|
|
46 the given selection type. This is for elisp-level extension of the emacs
|
|
47 selection handling.
|
|
48 */
|
|
49 Lisp_Object Vselection_converter_alist;
|
|
50
|
|
51 Lisp_Object Vlost_selection_hooks;
|
|
52
|
|
53 /* This is an association list whose elements are of the form
|
|
54 ( selection-name selection-value selection-timestamp )
|
|
55 selection-name is a lisp symbol, whose name is the name of an X Atom.
|
|
56 selection-value is the value that emacs owns for that selection.
|
|
57 It may be any kind of Lisp object.
|
|
58 selection-timestamp is the time at which emacs began owning this selection,
|
|
59 as a cons of two 16-bit numbers (making a 32 bit time).
|
|
60 If there is an entry in this alist, then it can be assumed that emacs owns
|
|
61 that selection.
|
|
62 The only (eq) parts of this list that are visible from elisp are the
|
|
63 selection-values.
|
|
64 */
|
|
65 Lisp_Object Vselection_alist;
|
|
66
|
|
67 static Lisp_Object
|
|
68 clean_local_selection_data (Lisp_Object obj)
|
|
69 {
|
|
70 if (CONSP (obj) &&
|
|
71 INTP (XCAR (obj)) &&
|
|
72 CONSP (XCDR (obj)) &&
|
|
73 INTP (XCAR (XCDR (obj))) &&
|
|
74 NILP (XCDR (XCDR (obj))))
|
|
75 obj = Fcons (XCAR (obj), XCDR (obj));
|
|
76
|
|
77 if (CONSP (obj) &&
|
|
78 INTP (XCAR (obj)) &&
|
|
79 INTP (XCDR (obj)))
|
|
80 {
|
|
81 if (XINT (XCAR (obj)) == 0)
|
|
82 return XCDR (obj);
|
|
83 if (XINT (XCAR (obj)) == -1)
|
|
84 return make_int (- XINT (XCDR (obj)));
|
|
85 }
|
|
86 if (VECTORP (obj))
|
|
87 {
|
|
88 int i;
|
|
89 int len = XVECTOR_LENGTH (obj);
|
|
90 Lisp_Object copy;
|
|
91 if (len == 1)
|
|
92 return clean_local_selection_data (XVECTOR_DATA (obj) [0]);
|
|
93 copy = make_vector (len, Qnil);
|
|
94 for (i = 0; i < len; i++)
|
|
95 XVECTOR_DATA (copy) [i] =
|
|
96 clean_local_selection_data (XVECTOR_DATA (obj) [i]);
|
|
97 return copy;
|
|
98 }
|
|
99 return obj;
|
|
100 }
|
|
101
|
|
102 /* Given a selection-name and desired type, this looks up our local copy of
|
|
103 the selection value and converts it to the type. It returns nil or a
|
|
104 string. This calls random elisp code, and may signal or gc.
|
|
105 */
|
|
106 Lisp_Object
|
|
107 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
|
|
108 {
|
|
109 /* This function can GC */
|
|
110 Lisp_Object handler_fn, value, check;
|
|
111 Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
|
|
112
|
|
113 if (NILP (local_value)) return Qnil;
|
|
114
|
|
115 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
|
|
116 if (EQ (target_type, QTIMESTAMP))
|
|
117 {
|
|
118 handler_fn = Qnil;
|
|
119 value = XCAR (XCDR (XCDR (local_value)));
|
|
120 }
|
|
121
|
|
122 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
|
|
123 else if (CONSP (target_type) &&
|
|
124 XCAR (target_type) == QMULTIPLE)
|
|
125 {
|
|
126 Lisp_Object pairs = XCDR (target_type);
|
|
127 int len = XVECTOR_LENGTH (pairs);
|
|
128 int i;
|
|
129 /* If the target is MULTIPLE, then target_type looks like
|
|
130 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
|
|
131 We modify the second element of each pair in the vector and
|
|
132 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
|
|
133 */
|
|
134 for (i = 0; i < len; i++)
|
|
135 {
|
|
136 Lisp_Object pair = XVECTOR_DATA (pairs) [i];
|
|
137 XVECTOR_DATA (pair) [1] =
|
|
138 x_get_local_selection (XVECTOR_DATA (pair) [0],
|
|
139 XVECTOR_DATA (pair) [1]);
|
|
140 }
|
|
141 return pairs;
|
|
142 }
|
|
143 #endif
|
|
144 else
|
|
145 {
|
|
146 CHECK_SYMBOL (target_type);
|
|
147 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
|
|
148 if (NILP (handler_fn)) return Qnil;
|
|
149 value = call3 (handler_fn,
|
|
150 selection_symbol, target_type,
|
|
151 XCAR (XCDR (local_value)));
|
|
152 }
|
|
153
|
|
154 /* This lets the selection function to return (TYPE . VALUE). For example,
|
|
155 when the selected type is LINE_NUMBER, the returned type is SPAN, not
|
|
156 INTEGER.
|
|
157 */
|
|
158 check = value;
|
|
159 if (CONSP (value) && SYMBOLP (XCAR (value)))
|
|
160 check = XCDR (value);
|
|
161
|
|
162 /* Strings, vectors, and symbols are converted to selection data format in
|
|
163 the obvious way. Integers are converted to 16 bit quantities if they're
|
|
164 small enough, otherwise 32 bits are used.
|
|
165 */
|
|
166 if (STRINGP (check) ||
|
|
167 VECTORP (check) ||
|
|
168 SYMBOLP (check) ||
|
|
169 INTP (check) ||
|
|
170 CHARP (check) ||
|
|
171 NILP (value))
|
|
172 return value;
|
|
173
|
|
174 /* (N . M) or (N M) get turned into a 32 bit quantity. So if you want to
|
|
175 always return a small quantity as 32 bits, your converter routine needs
|
|
176 to return a cons.
|
|
177 */
|
|
178 else if (CONSP (check) &&
|
|
179 INTP (XCAR (check)) &&
|
|
180 (INTP (XCDR (check)) ||
|
|
181 (CONSP (XCDR (check)) &&
|
|
182 INTP (XCAR (XCDR (check))) &&
|
|
183 NILP (XCDR (XCDR (check))))))
|
|
184 return value;
|
|
185 /* Otherwise the lisp converter function returned something unrecognized.
|
|
186 */
|
|
187 else
|
|
188 signal_error (Qerror,
|
|
189 list3 (build_string
|
|
190 ("unrecognized selection-conversion type"),
|
|
191 handler_fn,
|
|
192 value));
|
|
193
|
|
194 return Qnil; /* suppress compiler warning */
|
|
195 }
|
|
196
|
|
197 DEFUN ("own-selection-internal", Fown_selection_internal, 2, 3, 0, /*
|
|
198 Assert a selection of the given TYPE with the given VALUE.
|
|
199 TYPE is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
|
|
200 VALUE is typically a string, or a cons of two markers, but may be
|
|
201 anything that the functions on selection-converter-alist know about.
|
|
202 */
|
|
203 (selection_name, selection_value, device))
|
|
204 {
|
|
205 Lisp_Object selection_time, selection_data, prev_value;
|
440
|
206 struct gcpro gcpro1;
|
414
|
207
|
|
208 CHECK_SYMBOL (selection_name);
|
|
209 if (NILP (selection_value)) error ("selection-value may not be nil.");
|
|
210
|
|
211 if (NILP (device))
|
|
212 device = Fselected_device (Qnil);
|
|
213
|
|
214 /* Now update the local cache */
|
|
215 selection_data = list3 (selection_name,
|
|
216 selection_value,
|
|
217 Qnil);
|
440
|
218 GCPRO1 (selection_data);
|
|
219
|
414
|
220 prev_value = assq_no_quit (selection_name, Vselection_alist);
|
|
221 Vselection_alist = Fcons (selection_data, Vselection_alist);
|
|
222
|
|
223 /* If we already owned the selection, remove the old selection data.
|
|
224 Perhaps we should destructively modify it instead.
|
|
225 Don't use Fdelq() as that may QUIT;.
|
|
226 */
|
|
227 if (!NILP (prev_value))
|
|
228 {
|
|
229 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
|
|
230 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
|
|
231 if (EQ (prev_value, Fcar (XCDR (rest))))
|
|
232 {
|
|
233 XCDR (rest) = Fcdr (XCDR (rest));
|
|
234 break;
|
|
235 }
|
|
236 }
|
|
237
|
|
238 /* have to do device specific stuff last so that methods can access the
|
|
239 selection_alist */
|
|
240 if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
|
|
241 selection_time = DEVMETH (XDEVICE (device), own_selection,
|
|
242 (selection_name, selection_value));
|
|
243 else
|
|
244 selection_time = Qnil;
|
|
245
|
|
246 Fsetcar (XCDR (XCDR (selection_data)), selection_time);
|
|
247
|
440
|
248 UNGCPRO;
|
|
249
|
414
|
250 return selection_value;
|
|
251 }
|
|
252
|
|
253 /* remove a selection from our local copy
|
|
254 */
|
|
255 void
|
|
256 handle_selection_clear (Lisp_Object selection_symbol)
|
|
257 {
|
|
258 Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
|
|
259
|
|
260 /* Well, we already believe that we don't own it, so that's just fine. */
|
|
261 if (NILP (local_selection_data)) return;
|
|
262
|
|
263 /* Otherwise, we're really honest and truly being told to drop it.
|
|
264 Don't use Fdelq() as that may QUIT;.
|
|
265 */
|
|
266 if (EQ (local_selection_data, Fcar (Vselection_alist)))
|
|
267 Vselection_alist = Fcdr (Vselection_alist);
|
|
268 else
|
|
269 {
|
|
270 Lisp_Object rest;
|
|
271 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
|
|
272 if (EQ (local_selection_data, Fcar (XCDR (rest))))
|
|
273 {
|
|
274 XCDR (rest) = Fcdr (XCDR (rest));
|
|
275 break;
|
|
276 }
|
|
277 }
|
|
278
|
|
279 /* Let random lisp code notice that the selection has been stolen.
|
|
280 */
|
|
281 {
|
|
282 Lisp_Object rest;
|
|
283 Lisp_Object val = Vlost_selection_hooks;
|
|
284 if (!UNBOUNDP (val) && !NILP (val))
|
|
285 {
|
|
286 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
|
|
287 for (rest = val; !NILP (rest); rest = Fcdr (rest))
|
|
288 call1 (Fcar (rest), selection_symbol);
|
|
289 else
|
|
290 call1 (val, selection_symbol);
|
|
291 }
|
|
292 }
|
|
293 }
|
|
294
|
|
295 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
|
|
296 If we own the named selection, then disown it (make there be no selection).
|
|
297 */
|
|
298 (selection_name, selection_time, device))
|
|
299 {
|
|
300 if (NILP (assq_no_quit (selection_name, Vselection_alist)))
|
|
301 return Qnil; /* Don't disown the selection when we're not the owner. */
|
|
302
|
|
303 if (NILP (device))
|
|
304 device = Fselected_device (Qnil);
|
|
305
|
|
306 MAYBE_DEVMETH (XDEVICE (device), disown_selection,
|
|
307 (selection_name, selection_time));
|
|
308
|
|
309 handle_selection_clear (selection_name);
|
|
310
|
|
311 return Qt;
|
|
312 }
|
|
313
|
|
314 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
|
|
315 Return t if current emacs process owns the given Selection.
|
|
316 The arg should be the name of the selection in question, typically one of
|
|
317 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
|
|
318 nil is the same as PRIMARY, and t is the same as SECONDARY.)
|
|
319 */
|
|
320 (selection))
|
|
321 {
|
|
322 CHECK_SYMBOL (selection);
|
|
323 if (EQ (selection, Qnil)) selection = QPRIMARY;
|
|
324 else if (EQ (selection, Qt)) selection = QSECONDARY;
|
|
325
|
|
326 return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
|
|
327 }
|
|
328
|
|
329 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /*
|
|
330 Whether there is an owner for the given Selection.
|
|
331 The arg should be the name of the selection in question, typically one of
|
|
332 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
|
|
333 nil is the same as PRIMARY, and t is the same as SECONDARY.)
|
|
334 */
|
|
335 (selection, device))
|
|
336 {
|
|
337 CHECK_SYMBOL (selection);
|
|
338 if (!NILP (Fselection_owner_p (selection)))
|
|
339 return Qt;
|
|
340
|
|
341 if (NILP (device))
|
|
342 device = Fselected_device (Qnil);
|
|
343
|
|
344 return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
|
|
345 DEVMETH (XDEVICE (device), selection_exists_p, (selection))
|
|
346 : Qnil;
|
|
347 }
|
|
348
|
|
349 /* Request the selection value from the owner. If we are the owner,
|
|
350 simply return our selection value. If we are not the owner, this
|
|
351 will block until all of the data has arrived.
|
|
352 */
|
|
353 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
|
|
354 Return text selected from some window-system window.
|
|
355 SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
|
|
356 TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
|
|
357 Under Mule, if the resultant data comes back as 8-bit data in type
|
|
358 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
|
|
359 */
|
|
360 (selection_symbol, target_type, device))
|
|
361 {
|
|
362 /* This function can GC */
|
|
363 Lisp_Object val = Qnil;
|
|
364 struct gcpro gcpro1, gcpro2;
|
|
365 GCPRO2 (target_type, val); /* we store newly consed data into these */
|
|
366 CHECK_SYMBOL (selection_symbol);
|
|
367
|
|
368 if (NILP (device))
|
|
369 device = Fselected_device (Qnil);
|
|
370
|
|
371 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
|
|
372 if (CONSP (target_type) &&
|
|
373 XCAR (target_type) == QMULTIPLE)
|
|
374 {
|
|
375 CHECK_VECTOR (XCDR (target_type));
|
|
376 /* So we don't destructively modify this... */
|
|
377 target_type = copy_multiple_data (target_type);
|
|
378 }
|
|
379 else
|
|
380 #endif
|
|
381 CHECK_SYMBOL (target_type);
|
|
382
|
|
383 val = get_local_selection (selection_symbol, target_type);
|
|
384
|
|
385 if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)))
|
|
386 {
|
|
387 val = DEVMETH (XDEVICE (device), get_foreign_selection,
|
|
388 (selection_symbol, target_type));
|
|
389 }
|
|
390 else
|
|
391 {
|
|
392 if (CONSP (val) && SYMBOLP (XCAR (val)))
|
|
393 {
|
|
394 val = XCDR (val);
|
|
395 if (CONSP (val) && NILP (XCDR (val)))
|
|
396 val = XCAR (val);
|
|
397 }
|
|
398 val = clean_local_selection_data (val);
|
|
399 }
|
|
400 UNGCPRO;
|
|
401 return val;
|
|
402 }
|
|
403
|
|
404 void
|
|
405 syms_of_select (void)
|
|
406 {
|
|
407 DEFSUBR (Fown_selection_internal);
|
|
408 DEFSUBR (Fget_selection_internal);
|
|
409 DEFSUBR (Fselection_exists_p);
|
|
410 DEFSUBR (Fdisown_selection_internal);
|
|
411 DEFSUBR (Fselection_owner_p);
|
|
412
|
|
413 defsymbol (&QPRIMARY, "PRIMARY");
|
|
414 defsymbol (&QSECONDARY, "SECONDARY");
|
|
415 defsymbol (&QSTRING, "STRING");
|
|
416 defsymbol (&QINTEGER, "INTEGER");
|
|
417 defsymbol (&QCLIPBOARD, "CLIPBOARD");
|
|
418 defsymbol (&QTIMESTAMP, "TIMESTAMP");
|
|
419 defsymbol (&QTEXT, "TEXT");
|
|
420 defsymbol (&QDELETE, "DELETE");
|
|
421 defsymbol (&QMULTIPLE, "MULTIPLE");
|
|
422 defsymbol (&QINCR, "INCR");
|
|
423 defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
|
|
424 defsymbol (&QTARGETS, "TARGETS");
|
|
425 defsymbol (&QATOM, "ATOM");
|
|
426 defsymbol (&QATOM_PAIR, "ATOM_PAIR");
|
|
427 defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
|
|
428 defsymbol (&QNULL, "NULL");
|
|
429
|
|
430 deferror (&Qselection_conversion_error,
|
|
431 "selection-conversion-error",
|
|
432 "selection-conversion error", Qio_error);
|
|
433 }
|
|
434
|
|
435 void
|
|
436 vars_of_select (void)
|
|
437 {
|
|
438 Vselection_alist = Qnil;
|
|
439 staticpro (&Vselection_alist);
|
|
440
|
|
441 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
|
|
442 An alist associating selection-types (such as STRING and TIMESTAMP) with
|
|
443 functions. These functions will be called with three args: the name
|
|
444 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
|
|
445 desired type to which the selection should be converted; and the local
|
|
446 selection value (whatever had been passed to `own-selection'). For
|
|
447 historical reasons these functions should return the value to send to
|
|
448 an X server, which should be one of:
|
|
449
|
|
450 -- nil (the conversion could not be done)
|
|
451 -- a cons of a symbol and any of the following values; the symbol
|
|
452 explicitly specifies the type that will be sent.
|
|
453 -- a string (If the type is not specified, then if Mule support exists,
|
|
454 the string will be converted to Compound Text and sent in
|
|
455 the 'COMPOUND_TEXT format; otherwise (no Mule support),
|
|
456 the string will be left as-is and sent in the 'STRING
|
|
457 format. If the type is specified, the string will be
|
|
458 left as-is (or converted to binary format under Mule).
|
|
459 In all cases, 8-bit data it sent.)
|
|
460 -- a character (With Mule support, will be converted to Compound Text
|
|
461 whether or not a type is specified. If a type is not
|
|
462 specified, a type of 'STRING or 'COMPOUND_TEXT will be
|
|
463 sent, as for strings.)
|
|
464 -- the symbol 'NULL (Indicates that there is no meaningful return value.
|
|
465 Empty 32-bit data with a type of 'NULL will be sent.)
|
|
466 -- a symbol (Will be converted into an atom. If the type is not specified,
|
|
467 a type of 'ATOM will be sent.)
|
|
468 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
|
|
469 on the value. If the type is not specified, a type of
|
|
470 'INTEGER will be sent.)
|
|
471 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
|
|
472 If the type is not specified, a type of
|
|
473 'INTEGER will be sent.)
|
|
474 -- a vector of symbols (Will be converted into a list of atoms. If the type
|
|
475 is not specified, a type of 'ATOM will be sent.)
|
|
476 -- a vector of integers (Will be converted into a list of 16-bit integers.
|
|
477 If the type is not specified, a type of 'INTEGER
|
|
478 will be sent.)
|
|
479 -- a vector of integers and/or conses (HIGH . LOW) of integers
|
|
480 (Will be converted into a list of 16-bit integers.
|
|
481 If the type is not specified, a type of 'INTEGER
|
|
482 will be sent.) */ );
|
|
483 Vselection_converter_alist = Qnil;
|
|
484
|
|
485 DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
|
|
486 A function or functions to be called after we have been notified
|
|
487 that we have lost the selection. The function(s) will be called with one
|
|
488 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
|
|
489 CLIPBOARD).
|
|
490 */ );
|
|
491 Vlost_selection_hooks = Qunbound;
|
|
492 }
|
|
493
|