1 /* GTK selection processing for XEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not synched with FSF. */
25 Written by Kevin Gallo for FSF Emacs.
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
27 Rewritten for GTK by William Perry, April 2000 for 21.1
36 #include "console-gtk.h"
41 int lisp_to_time (Lisp_Object, time_t *);
42 static Lisp_Object Vretrieved_selection;
43 static gboolean waiting_for_selection;
44 Lisp_Object Vgtk_sent_selection_hooks;
46 static Lisp_Object atom_to_symbol (struct device *d, GdkAtom atom);
47 static GdkAtom symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists);
49 static void lisp_data_to_selection_data (struct device *,
51 unsigned char **data_ret,
53 unsigned int *size_ret,
55 static Lisp_Object selection_data_to_lisp_data (struct device *,
61 /* Set the selection data to GDK_NONE and NULL data, meaning we were
62 ** unable to do what they wanted.
65 gtk_decline_selection_request (GtkSelectionData *data)
67 gtk_selection_data_set (data, GDK_NONE, 0, NULL, 0);
70 /* Used as an unwind-protect clause so that, if a selection-converter signals
71 an error, we tell the requestor that we were unable to do what they wanted
72 before we throw to top-level or go into the debugger or whatever.
74 struct _selection_closure
76 GtkSelectionData *data;
81 gtk_selection_request_lisp_error (Lisp_Object closure)
83 struct _selection_closure *cl = (struct _selection_closure *)
84 get_opaque_ptr (closure);
86 free_opaque_ptr (closure);
87 if (cl->successful == TRUE)
89 gtk_decline_selection_request (cl->data);
93 /* This provides the current selection to a requester.
95 ** This is connected to the selection_get() signal of the application
96 ** shell in device-gtk.c:gtk_init_device().
98 ** This is radically different than the old selection code (21.1.x),
99 ** but has been modeled after the X code, and appears to work.
104 emacs_gtk_selection_handle (GtkWidget *widget,
105 GtkSelectionData *selection_data,
110 /* This function can GC */
111 struct gcpro gcpro1, gcpro2;
112 Lisp_Object temp_obj;
113 Lisp_Object selection_symbol;
114 Lisp_Object target_symbol = Qnil;
115 Lisp_Object converted_selection = Qnil;
116 guint32 local_selection_time;
117 Lisp_Object successful_p = Qnil;
119 struct device *d = decode_gtk_device (Qnil);
120 struct _selection_closure *cl = NULL;
122 GCPRO2 (converted_selection, target_symbol);
124 selection_symbol = atom_to_symbol (d, selection_data->selection);
125 target_symbol = atom_to_symbol (d, selection_data->target);
127 #if 0 /* #### MULTIPLE doesn't work yet */
128 if (EQ (target_symbol, QMULTIPLE))
129 target_symbol = fetch_multiple_target (selection_data);
132 temp_obj = Fget_selection_timestamp (selection_symbol);
136 /* We don't appear to have the selection. */
137 gtk_decline_selection_request (selection_data);
142 local_selection_time = * (guint32 *) XOPAQUE_DATA (temp_obj);
144 if (time_stamp != GDK_CURRENT_TIME &&
145 local_selection_time > time_stamp)
147 /* Someone asked for the selection, and we have one, but not the one
148 they're looking for. */
149 gtk_decline_selection_request (selection_data);
153 converted_selection = select_convert_out (selection_symbol,
154 target_symbol, Qnil);
156 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
157 if (NILP (converted_selection))
159 /* We don't appear to have a selection in that data type. */
160 gtk_decline_selection_request (selection_data);
164 count = specpdl_depth ();
166 cl = (struct _selection_closure *) xmalloc (sizeof (*cl));
167 cl->data = selection_data;
168 cl->successful = FALSE;
170 record_unwind_protect (gtk_selection_request_lisp_error,
171 make_opaque_ptr (cl));
178 lisp_data_to_selection_data (d, converted_selection,
179 &data, &type, &size, &format);
181 gtk_selection_data_set (selection_data, type, format, data, size);
183 /* Tell x_selection_request_lisp_error() it's cool. */
184 cl->successful = TRUE;
188 unbind_to (count, Qnil);
196 /* Let random lisp code notice that the selection has been asked for. */
198 Lisp_Object val = Vgtk_sent_selection_hooks;
199 if (!UNBOUNDP (val) && !NILP (val))
202 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
203 for (rest = val; !NILP (rest); rest = Fcdr (rest))
204 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
206 call3 (val, selection_symbol, target_symbol, successful_p);
213 static GtkWidget *reading_selection_reply;
214 static GdkAtom reading_which_selection;
215 static int selection_reply_timed_out;
217 /* Gets the current selection owned by another application */
219 emacs_gtk_selection_received (GtkWidget *widget,
220 GtkSelectionData *selection_data,
223 waiting_for_selection = FALSE;
224 Vretrieved_selection = Qnil;
226 reading_selection_reply = NULL;
228 signal_fake_event ();
230 if (selection_data->length < 0)
235 Vretrieved_selection =
236 selection_data_to_lisp_data (NULL,
237 selection_data->data,
238 selection_data->length,
239 selection_data->type,
240 selection_data->format);
244 selection_reply_done (void *ignore)
246 return !reading_selection_reply;
249 /* Do protocol to read selection-data from the server.
250 Converts this to lisp data and returns it.
253 gtk_get_foreign_selection (Lisp_Object selection_symbol,
254 Lisp_Object target_type)
256 /* This function can GC */
257 struct device *d = decode_gtk_device (Qnil);
258 GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d);
259 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d);
260 GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0);
262 GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ?
263 XCAR (target_type) : target_type), 0);
265 gtk_selection_convert (requestor, selection_atom, type_atom,
268 signal_fake_event ();
270 /* Block until the reply has been read. */
271 reading_selection_reply = requestor;
272 reading_which_selection = selection_atom;
273 selection_reply_timed_out = 0;
275 speccount = specpdl_depth ();
278 /* add a timeout handler */
279 if (gtk_selection_timeout > 0)
281 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
282 Qx_selection_reply_timeout_internal,
284 record_unwind_protect (Fdisable_timeout, id);
289 wait_delaying_user_input (selection_reply_done, 0);
291 if (selection_reply_timed_out)
292 error ("timed out waiting for reply from selection owner");
294 unbind_to (speccount, Qnil);
296 /* otherwise, the selection is waiting for us on the requested property. */
297 return select_convert_in (selection_symbol,
299 Vretrieved_selection);
305 gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property,
306 Extbyte **data_ret, int *bytes_ret,
307 GdkAtom *actual_type_ret, int *actual_format_ret,
308 unsigned long *actual_size_ret, int delete_p)
311 unsigned long bytes_remaining;
313 unsigned char *tmp_data = 0;
315 int buffer_size = SELECTION_QUANTUM (display);
316 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
318 /* First probe the thing to find out how big it is. */
319 result = XGetWindowProperty (display, window, property,
320 0, 0, False, AnyPropertyType,
321 actual_type_ret, actual_format_ret,
323 &bytes_remaining, &tmp_data);
324 if (result != Success)
330 XFree ((char *) tmp_data);
332 if (*actual_type_ret == None || *actual_format_ret == 0)
334 if (delete_p) XDeleteProperty (display, window, property);
340 total_size = bytes_remaining + 1;
341 *data_ret = (Extbyte *) xmalloc (total_size);
343 /* Now read, until we've gotten it all. */
344 while (bytes_remaining)
347 int last = bytes_remaining;
350 XGetWindowProperty (display, window, property,
351 offset/4, buffer_size/4,
352 (delete_p ? True : False),
354 actual_type_ret, actual_format_ret,
355 actual_size_ret, &bytes_remaining, &tmp_data);
357 stderr_out ("<< read %d\n", last-bytes_remaining);
359 /* If this doesn't return Success at this point, it means that
360 some clod deleted the selection while we were in the midst of
361 reading it. Deal with that, I guess....
363 if (result != Success) break;
364 *actual_size_ret *= *actual_format_ret / 8;
365 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
366 offset += *actual_size_ret;
367 XFree ((char *) tmp_data);
374 receive_incremental_selection (Display *display, Window window, Atom property,
375 /* this one is for error messages only */
376 Lisp_Object target_type,
377 unsigned int min_size_bytes,
378 Extbyte **data_ret, int *size_bytes_ret,
379 Atom *type_ret, int *format_ret,
380 unsigned long *size_ret)
382 /* This function can GC */
385 *size_bytes_ret = min_size_bytes;
386 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
388 stderr_out ("\nread INCR %d\n", min_size_bytes);
390 /* At this point, we have read an INCR property, and deleted it (which
391 is how we ack its receipt: the sending window will be selecting
392 PropertyNotify events on our window to notice this).
394 Now, we must loop, waiting for the sending window to put a value on
395 that property, then reading the property, then deleting it to ack.
396 We are done when the sender places a property of length 0.
398 prop_id = expect_property_change (display, window, property,
404 wait_for_property_change (prop_id);
405 /* expect it again immediately, because x_get_window_property may
406 .. no it won't, I don't get it.
407 .. Ok, I get it now, the Xt code that implements INCR is broken.
409 prop_id = expect_property_change (display, window, property,
411 x_get_window_property (display, window, property,
412 &tmp_data, &tmp_size_bytes,
413 type_ret, format_ret, size_ret, 1);
415 if (tmp_size_bytes == 0) /* we're done */
418 stderr_out (" read INCR done\n");
420 unexpect_property_change (prop_id);
421 if (tmp_data) xfree (tmp_data);
425 stderr_out (" read INCR %d\n", tmp_size_bytes);
427 if (*size_bytes_ret < offset + tmp_size_bytes)
430 stderr_out (" read INCR realloc %d -> %d\n",
431 *size_bytes_ret, offset + tmp_size_bytes);
433 *size_bytes_ret = offset + tmp_size_bytes;
434 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
436 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
437 offset += tmp_size_bytes;
444 gtk_get_window_property_as_lisp_data (struct device *d,
447 /* next two for error messages only */
448 Lisp_Object target_type,
449 GdkAtom selection_atom)
451 /* This function can GC */
454 unsigned long actual_size;
455 Extbyte *data = NULL;
458 struct device *d = get_device_from_display (display);
460 x_get_window_property (display, window, property, &data, &bytes,
461 &actual_type, &actual_format, &actual_size, 1);
464 if (XGetSelectionOwner (display, selection_atom))
465 /* there is a selection owner */
467 (Qselection_conversion_error,
468 Fcons (build_string ("selection owner couldn't convert"),
469 Fcons (x_atom_to_symbol (d, selection_atom),
471 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
472 list1 (target_type))));
474 signal_error (Qerror,
475 list2 (build_string ("no selection"),
476 x_atom_to_symbol (d, selection_atom)));
479 if (actual_type == DEVICE_XATOM_INCR (d))
481 /* Ok, that data wasn't *the* data, it was just the beginning. */
483 unsigned int min_size_bytes = * ((unsigned int *) data);
485 receive_incremental_selection (display, window, property, target_type,
486 min_size_bytes, &data, &bytes,
487 &actual_type, &actual_format,
491 /* It's been read. Now convert it to a lisp object in some semi-rational
493 val = selection_data_to_lisp_data (d, data, bytes,
494 actual_type, actual_format);
503 symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists)
505 if (NILP (sym)) return GDK_SELECTION_PRIMARY;
506 if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY;
507 if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY;
508 if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY;
512 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
513 return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE);
518 atom_to_symbol (struct device *d, GdkAtom atom)
520 if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY);
521 if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY);
525 char *str = gdk_atom_name (atom);
527 if (! str) return Qnil;
529 TO_INTERNAL_FORMAT (C_STRING, str,
530 C_STRING_ALLOCA, intstr,
533 return intern (intstr);
537 /* #### These are going to move into Lisp code(!) with the aid of
538 some new functions I'm working on - ajh */
540 /* These functions convert from the selection data read from the server into
541 something that we can use from elisp, and vice versa.
543 Type: Format: Size: Elisp Type:
544 ----- ------- ----- -----------
547 ATOM 32 > 1 Vector of Symbols
549 * 16 > 1 Vector of Integers
550 * 32 1 if <=16 bits: Integer
551 if > 16 bits: Cons of top16, bot16
552 * 32 > 1 Vector of the above
554 When converting a Lisp number to C, it is assumed to be of format 16 if
555 it is an integer, and of format 32 if it is a cons of two integers.
557 When converting a vector of numbers from Elisp to C, it is assumed to be
558 of format 16 if every element in the vector is an integer, and is assumed
559 to be of format 32 if any element is a cons of two integers.
561 When converting an object to C, it may be of the form (SYMBOL . <data>)
562 where SYMBOL is what we should claim that the type is. Format and
563 representation are as above.
565 NOTE: Under Mule, when someone shoves us a string without a type, we
566 set the type to 'COMPOUND_TEXT and automatically convert to Compound
567 Text. If the string has a type, we assume that the user wants the
568 data sent as-is so we just do "binary" conversion.
573 selection_data_to_lisp_data (struct device *d,
579 if (type == gdk_atom_intern ("NULL", 0))
582 /* Convert any 8-bit data to a string, for compactness. */
583 else if (format == 8)
584 return make_ext_string (data, size,
585 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
586 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
589 /* Convert a single atom to a Lisp Symbol.
590 Convert a set of atoms to a vector of symbols. */
591 else if (type == gdk_atom_intern ("ATOM", FALSE))
593 if (size == sizeof (GdkAtom))
594 return atom_to_symbol (d, *((GdkAtom *) data));
598 int len = size / sizeof (GdkAtom);
599 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
600 for (i = 0; i < len; i++)
601 Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i]));
606 /* Convert a single 16 or small 32 bit number to a Lisp Int.
607 If the number is > 16 bits, convert it to a cons of integers,
608 16 bits in each half.
610 else if (format == 32 && size == sizeof (long))
611 return word_to_lisp (((unsigned long *) data) [0]);
612 else if (format == 16 && size == sizeof (short))
613 return make_int ((int) (((unsigned short *) data) [0]));
615 /* Convert any other kind of data to a vector of numbers, represented
616 as above (as an integer, or a cons of two 16 bit integers).
618 #### Perhaps we should return the actual type to lisp as well.
620 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
623 and perhaps it should be
625 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
628 Right now the fact that the return type was SPAN is discarded before
629 lisp code gets to see it.
631 else if (format == 16)
634 Lisp_Object v = make_vector (size / 4, Qzero);
635 for (i = 0; i < (int) size / 4; i++)
637 int j = (int) ((unsigned short *) data) [i];
638 Faset (v, make_int (i), make_int (j));
645 Lisp_Object v = make_vector (size / 4, Qzero);
646 for (i = 0; i < (int) size / 4; i++)
648 unsigned long j = ((unsigned long *) data) [i];
649 Faset (v, make_int (i), word_to_lisp (j));
657 lisp_data_to_selection_data (struct device *d,
659 unsigned char **data_ret,
661 unsigned int *size_ret,
664 Lisp_Object type = Qnil;
666 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
670 if (CONSP (obj) && NILP (XCDR (obj)))
674 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
675 { /* This is not the same as declining */
681 else if (STRINGP (obj))
683 const Extbyte *extval;
686 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
687 ALLOCA, (extval, extvallen),
688 (NILP (type) ? Qctext : Qbinary));
690 *size_ret = extvallen;
691 *data_ret = (unsigned char *) xmalloc (*size_ret);
692 memcpy (*data_ret, extval, *size_ret);
694 if (NILP (type)) type = QCOMPOUND_TEXT;
696 if (NILP (type)) type = QSTRING;
699 else if (CHARP (obj))
701 Bufbyte buf[MAX_EMCHAR_LEN];
703 const Extbyte *extval;
707 len = set_charptr_emchar (buf, XCHAR (obj));
708 TO_EXTERNAL_FORMAT (DATA, (buf, len),
709 ALLOCA, (extval, extvallen),
711 *size_ret = extvallen;
712 *data_ret = (unsigned char *) xmalloc (*size_ret);
713 memcpy (*data_ret, extval, *size_ret);
715 if (NILP (type)) type = QCOMPOUND_TEXT;
717 if (NILP (type)) type = QSTRING;
720 else if (SYMBOLP (obj))
724 *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1);
725 (*data_ret) [sizeof (GdkAtom)] = 0;
726 (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0);
727 if (NILP (type)) type = QATOM;
729 else if (INTP (obj) &&
730 XINT (obj) <= 0x7FFF &&
731 XINT (obj) >= -0x8000)
735 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
736 (*data_ret) [sizeof (short)] = 0;
737 (*(short **) data_ret) [0] = (short) XINT (obj);
738 if (NILP (type)) type = QINTEGER;
740 else if (INTP (obj) || CONSP (obj))
744 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
745 (*data_ret) [sizeof (long)] = 0;
746 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
747 if (NILP (type)) type = QINTEGER;
749 else if (VECTORP (obj))
751 /* Lisp Vectors may represent a set of ATOMs;
752 a set of 16 or 32 bit INTEGERs;
753 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
757 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
758 /* This vector is an ATOM set */
760 if (NILP (type)) type = QATOM;
761 *size_ret = XVECTOR_LENGTH (obj);
763 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom));
764 for (i = 0; i < (int) (*size_ret); i++)
765 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
766 (*(GdkAtom **) data_ret) [i] =
767 symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0);
769 signal_error (Qerror, /* Qselection_error */
771 ("all elements of the vector must be of the same type"),
774 #if 0 /* #### MULTIPLE doesn't work yet */
775 else if (VECTORP (XVECTOR_DATA (obj) [0]))
776 /* This vector is an ATOM_PAIR set */
778 if (NILP (type)) type = QATOM_PAIR;
779 *size_ret = XVECTOR_LENGTH (obj);
781 *data_ret = (unsigned char *)
782 xmalloc ((*size_ret) * sizeof (Atom) * 2);
783 for (i = 0; i < *size_ret; i++)
784 if (VECTORP (XVECTOR_DATA (obj) [i]))
786 Lisp_Object pair = XVECTOR_DATA (obj) [i];
787 if (XVECTOR_LENGTH (pair) != 2)
788 signal_error (Qerror,
790 ("elements of the vector must be vectors of exactly two elements"),
793 (*(GdkAtom **) data_ret) [i * 2] =
794 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0);
795 (*(GdkAtom **) data_ret) [(i * 2) + 1] =
796 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0);
799 signal_error (Qerror,
801 ("all elements of the vector must be of the same type"),
806 /* This vector is an INTEGER set, or something like it */
808 *size_ret = XVECTOR_LENGTH (obj);
809 if (NILP (type)) type = QINTEGER;
811 for (i = 0; i < (int) (*size_ret); i++)
812 if (CONSP (XVECTOR_DATA (obj) [i]))
814 else if (!INTP (XVECTOR_DATA (obj) [i]))
815 signal_error (Qerror, /* Qselection_error */
817 ("all elements of the vector must be integers or conses of integers"),
820 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
821 for (i = 0; i < (int) (*size_ret); i++)
822 if (*format_ret == 32)
823 (*((unsigned long **) data_ret)) [i] =
824 lisp_to_word (XVECTOR_DATA (obj) [i]);
826 (*((unsigned short **) data_ret)) [i] =
827 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
831 signal_error (Qerror, /* Qselection_error */
832 list2 (build_string ("unrecognized selection data"),
835 *type_ret = symbol_to_gtk_atom (d, type, 0);
841 gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
842 Lisp_Object how_to_add, Lisp_Object selection_type)
844 struct device *d = decode_gtk_device (Qnil);
845 GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
846 Lisp_Object selection_time;
847 /* Use the time of the last-read mouse or keyboard event.
848 For selection purposes, we use this as a sleazy way of knowing what the
849 current time is in server-time. This assumes that the most recently read
850 mouse or keyboard event has something to do with the assertion of the
851 selection, which is probably true.
853 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d);
854 GdkAtom selection_atom;
856 CHECK_SYMBOL (selection_name);
857 selection_atom = symbol_to_gtk_atom (d, selection_name, 0);
859 gtk_selection_owner_set (selecting_window,
863 /* We do NOT use time_to_lisp() here any more, like we used to.
864 That assumed equivalence of time_t and Time, which is not
865 necessarily the case (e.g. under OSF on the Alphas, where
866 Time is a 64-bit quantity and time_t is a 32-bit quantity).
868 Opaque pointers are the clean way to go here.
870 selection_time = make_opaque (&thyme, sizeof (thyme));
872 return selection_time;
876 gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval)
878 struct device *d = decode_gtk_device (Qnil);
879 GdkAtom selection_atom;
882 CHECK_SYMBOL (selection);
883 selection_atom = symbol_to_gtk_atom (d, selection, 0);
886 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d);
890 lisp_to_time (timeval, &the_time);
891 timestamp = (guint32) the_time;
894 gtk_selection_owner_set (NULL, selection_atom, timestamp);
898 gtk_selection_exists_p (Lisp_Object selection,
899 Lisp_Object selection_type)
901 struct device *d = decode_gtk_device (Qnil);
903 return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil);
908 /************************************************************************/
910 /************************************************************************/
913 syms_of_select_gtk (void)
918 console_type_create_select_gtk (void)
920 CONSOLE_HAS_METHOD (gtk, own_selection);
921 CONSOLE_HAS_METHOD (gtk, disown_selection);
922 CONSOLE_HAS_METHOD (gtk, selection_exists_p);
923 CONSOLE_HAS_METHOD (gtk, get_foreign_selection);
927 vars_of_select_gtk (void)
929 staticpro (&Vretrieved_selection);
930 Vretrieved_selection = Qnil;
932 DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
933 A function or functions to be called after we have responded to some
934 other client's request for the value of a selection that we own. The
935 function(s) will be called with four arguments:
936 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
937 - the name of the selection-type which we were requested to convert the
938 selection into before sending (for example, STRING or LENGTH);
939 - and whether we successfully transmitted the selection.
940 We might have failed (and declined the request) for any number of reasons,
941 including being asked for a selection that we no longer own, or being asked
942 to convert into a type that we don't know about or that is inappropriate.
943 This hook doesn't let you change the behavior of emacs's selection replies,
944 it merely informs you that they have happened.
946 Vgtk_sent_selection_hooks = Qunbound;