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