1 /* Generic selection processing for XEmacs
2 Copyright (C) 1999 Free Software Foundation, Inc.
3 Copyright (C) 1999 Andy Piper.
5 This file is part of XEmacs.
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
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
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. */
22 /* Synched up with: Not synched with FSF. */
36 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
37 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
38 QATOM_PAIR, QCOMPOUND_TEXT;
40 /* "Selection owner couldn't convert selection" */
41 Lisp_Object Qselection_conversion_error;
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
49 Lisp_Object Vselection_converter_alist;
51 Lisp_Object Vlost_selection_hooks;
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
62 The only (eq) parts of this list that are visible from elisp are the
65 Lisp_Object Vselection_alist;
68 clean_local_selection_data (Lisp_Object obj)
73 INTP (XCAR (XCDR (obj))) &&
74 NILP (XCDR (XCDR (obj))))
75 obj = Fcons (XCAR (obj), XCDR (obj));
81 if (XINT (XCAR (obj)) == 0)
83 if (XINT (XCAR (obj)) == -1)
84 return make_int (- XINT (XCDR (obj)));
89 int len = XVECTOR_LENGTH (obj);
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]);
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.
107 get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
109 /* This function can GC */
110 Lisp_Object handler_fn, value, check;
111 Lisp_Object local_value = assq_no_quit (selection_symbol, Vselection_alist);
113 if (NILP (local_value)) return Qnil;
115 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
116 if (EQ (target_type, QTIMESTAMP))
119 value = XCAR (XCDR (XCDR (local_value)));
122 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
123 else if (CONSP (target_type) &&
124 XCAR (target_type) == QMULTIPLE)
126 Lisp_Object pairs = XCDR (target_type);
127 int len = XVECTOR_LENGTH (pairs);
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>] ... ]
134 for (i = 0; i < len; i++)
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]);
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)));
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
159 if (CONSP (value) && SYMBOLP (XCAR (value)))
160 check = XCDR (value);
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.
166 if (STRINGP (check) ||
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
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))))))
185 /* Otherwise the lisp converter function returned something unrecognized.
188 signal_error (Qerror,
190 ("unrecognized selection-conversion type"),
194 return Qnil; /* suppress compiler warning */
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.
203 (selection_name, selection_value, device))
205 Lisp_Object selection_time, selection_data, prev_value;
207 CHECK_SYMBOL (selection_name);
208 if (NILP (selection_value)) error ("selection-value may not be nil.");
211 device = Fselected_device (Qnil);
213 /* Now update the local cache */
214 selection_data = list3 (selection_name,
217 prev_value = assq_no_quit (selection_name, Vselection_alist);
218 Vselection_alist = Fcons (selection_data, Vselection_alist);
220 /* If we already owned the selection, remove the old selection data.
221 Perhaps we should destructively modify it instead.
222 Don't use Fdelq() as that may QUIT;.
224 if (!NILP (prev_value))
226 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
227 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
228 if (EQ (prev_value, Fcar (XCDR (rest))))
230 XCDR (rest) = Fcdr (XCDR (rest));
235 /* have to do device specific stuff last so that methods can access the
237 if (HAS_DEVMETH_P (XDEVICE (device), own_selection))
238 selection_time = DEVMETH (XDEVICE (device), own_selection,
239 (selection_name, selection_value));
241 selection_time = Qnil;
243 Fsetcar (XCDR (XCDR (selection_data)), selection_time);
245 return selection_value;
248 /* remove a selection from our local copy
251 handle_selection_clear (Lisp_Object selection_symbol)
253 Lisp_Object local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
255 /* Well, we already believe that we don't own it, so that's just fine. */
256 if (NILP (local_selection_data)) return;
258 /* Otherwise, we're really honest and truly being told to drop it.
259 Don't use Fdelq() as that may QUIT;.
261 if (EQ (local_selection_data, Fcar (Vselection_alist)))
262 Vselection_alist = Fcdr (Vselection_alist);
266 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
267 if (EQ (local_selection_data, Fcar (XCDR (rest))))
269 XCDR (rest) = Fcdr (XCDR (rest));
274 /* Let random lisp code notice that the selection has been stolen.
278 Lisp_Object val = Vlost_selection_hooks;
279 if (!UNBOUNDP (val) && !NILP (val))
281 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
282 for (rest = val; !NILP (rest); rest = Fcdr (rest))
283 call1 (Fcar (rest), selection_symbol);
285 call1 (val, selection_symbol);
290 DEFUN ("disown-selection-internal", Fdisown_selection_internal, 1, 3, 0, /*
291 If we own the named selection, then disown it (make there be no selection).
293 (selection_name, selection_time, device))
295 if (NILP (assq_no_quit (selection_name, Vselection_alist)))
296 return Qnil; /* Don't disown the selection when we're not the owner. */
299 device = Fselected_device (Qnil);
301 MAYBE_DEVMETH (XDEVICE (device), disown_selection,
302 (selection_name, selection_time));
304 handle_selection_clear (selection_name);
309 DEFUN ("selection-owner-p", Fselection_owner_p, 0, 1, 0, /*
310 Return t if current emacs process owns the given Selection.
311 The arg should be the name of the selection in question, typically one of
312 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
313 nil is the same as PRIMARY, and t is the same as SECONDARY.)
317 CHECK_SYMBOL (selection);
318 if (EQ (selection, Qnil)) selection = QPRIMARY;
319 else if (EQ (selection, Qt)) selection = QSECONDARY;
321 return NILP (Fassq (selection, Vselection_alist)) ? Qnil : Qt;
324 DEFUN ("selection-exists-p", Fselection_exists_p, 0, 2, 0, /*
325 Whether there is an owner for the given Selection.
326 The arg should be the name of the selection in question, typically one of
327 the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, the symbol
328 nil is the same as PRIMARY, and t is the same as SECONDARY.)
332 CHECK_SYMBOL (selection);
333 if (!NILP (Fselection_owner_p (selection)))
337 device = Fselected_device (Qnil);
339 return HAS_DEVMETH_P (XDEVICE (device), selection_exists_p) ?
340 DEVMETH (XDEVICE (device), selection_exists_p, (selection))
344 /* Request the selection value from the owner. If we are the owner,
345 simply return our selection value. If we are not the owner, this
346 will block until all of the data has arrived.
348 DEFUN ("get-selection-internal", Fget_selection_internal, 2, 3, 0, /*
349 Return text selected from some window-system window.
350 SELECTION_SYMBOL is a symbol, typically PRIMARY, SECONDARY, or CLIPBOARD.
351 TARGET_TYPE is the type of data desired, typically STRING or COMPOUND_TEXT.
352 Under Mule, if the resultant data comes back as 8-bit data in type
353 TEXT or COMPOUND_TEXT, it will be decoded as Compound Text.
355 (selection_symbol, target_type, device))
357 /* This function can GC */
358 Lisp_Object val = Qnil;
359 struct gcpro gcpro1, gcpro2;
360 GCPRO2 (target_type, val); /* we store newly consed data into these */
361 CHECK_SYMBOL (selection_symbol);
364 device = Fselected_device (Qnil);
366 #if 0 /* #### MULTIPLE doesn't work yet and probably never will */
367 if (CONSP (target_type) &&
368 XCAR (target_type) == QMULTIPLE)
370 CHECK_VECTOR (XCDR (target_type));
371 /* So we don't destructively modify this... */
372 target_type = copy_multiple_data (target_type);
376 CHECK_SYMBOL (target_type);
378 val = get_local_selection (selection_symbol, target_type);
380 if (NILP (val) && (HAS_DEVMETH_P (XDEVICE (device), get_foreign_selection)))
382 val = DEVMETH (XDEVICE (device), get_foreign_selection,
383 (selection_symbol, target_type));
387 if (CONSP (val) && SYMBOLP (XCAR (val)))
390 if (CONSP (val) && NILP (XCDR (val)))
393 val = clean_local_selection_data (val);
400 syms_of_select (void)
402 DEFSUBR (Fown_selection_internal);
403 DEFSUBR (Fget_selection_internal);
404 DEFSUBR (Fselection_exists_p);
405 DEFSUBR (Fdisown_selection_internal);
406 DEFSUBR (Fselection_owner_p);
408 defsymbol (&QPRIMARY, "PRIMARY");
409 defsymbol (&QSECONDARY, "SECONDARY");
410 defsymbol (&QSTRING, "STRING");
411 defsymbol (&QINTEGER, "INTEGER");
412 defsymbol (&QCLIPBOARD, "CLIPBOARD");
413 defsymbol (&QTIMESTAMP, "TIMESTAMP");
414 defsymbol (&QTEXT, "TEXT");
415 defsymbol (&QDELETE, "DELETE");
416 defsymbol (&QMULTIPLE, "MULTIPLE");
417 defsymbol (&QINCR, "INCR");
418 defsymbol (&QEMACS_TMP, "_EMACS_TMP_");
419 defsymbol (&QTARGETS, "TARGETS");
420 defsymbol (&QATOM, "ATOM");
421 defsymbol (&QATOM_PAIR, "ATOM_PAIR");
422 defsymbol (&QCOMPOUND_TEXT, "COMPOUND_TEXT");
423 defsymbol (&QNULL, "NULL");
425 deferror (&Qselection_conversion_error,
426 "selection-conversion-error",
427 "selection-conversion error", Qio_error);
431 vars_of_select (void)
433 Vselection_alist = Qnil;
434 staticpro (&Vselection_alist);
436 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist /*
437 An alist associating selection-types (such as STRING and TIMESTAMP) with
438 functions. These functions will be called with three args: the name
439 of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); a
440 desired type to which the selection should be converted; and the local
441 selection value (whatever had been passed to `own-selection'). For
442 historical reasons these functions should return the value to send to
443 an X server, which should be one of:
445 -- nil (the conversion could not be done)
446 -- a cons of a symbol and any of the following values; the symbol
447 explicitly specifies the type that will be sent.
448 -- a string (If the type is not specified, then if Mule support exists,
449 the string will be converted to Compound Text and sent in
450 the 'COMPOUND_TEXT format; otherwise (no Mule support),
451 the string will be left as-is and sent in the 'STRING
452 format. If the type is specified, the string will be
453 left as-is (or converted to binary format under Mule).
454 In all cases, 8-bit data it sent.)
455 -- a character (With Mule support, will be converted to Compound Text
456 whether or not a type is specified. If a type is not
457 specified, a type of 'STRING or 'COMPOUND_TEXT will be
458 sent, as for strings.)
459 -- the symbol 'NULL (Indicates that there is no meaningful return value.
460 Empty 32-bit data with a type of 'NULL will be sent.)
461 -- a symbol (Will be converted into an atom. If the type is not specified,
462 a type of 'ATOM will be sent.)
463 -- an integer (Will be converted into a 16-bit or 32-bit integer depending
464 on the value. If the type is not specified, a type of
465 'INTEGER will be sent.)
466 -- a cons (HIGH . LOW) of integers (Will be converted into a 32-bit integer.
467 If the type is not specified, a type of
468 'INTEGER will be sent.)
469 -- a vector of symbols (Will be converted into a list of atoms. If the type
470 is not specified, a type of 'ATOM will be sent.)
471 -- a vector of integers (Will be converted into a list of 16-bit integers.
472 If the type is not specified, a type of 'INTEGER
474 -- a vector of integers and/or conses (HIGH . LOW) of integers
475 (Will be converted into a list of 16-bit integers.
476 If the type is not specified, a type of 'INTEGER
478 Vselection_converter_alist = Qnil;
480 DEFVAR_LISP ("lost-selection-hooks", &Vlost_selection_hooks /*
481 A function or functions to be called after we have been notified
482 that we have lost the selection. The function(s) will be called with one
483 argument, a symbol naming the selection (typically PRIMARY, SECONDARY, or
486 Vlost_selection_hooks = Qunbound;