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