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 static Lisp_Object Vretrieved_selection;
42 static gboolean waiting_for_selection;
43 Lisp_Object Vgtk_sent_selection_hooks;
45 static Lisp_Object atom_to_symbol (struct device *d, GdkAtom atom);
46 static GdkAtom symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists);
48 static void lisp_data_to_selection_data (struct device *,
50 unsigned char **data_ret,
52 unsigned int *size_ret,
54 static Lisp_Object selection_data_to_lisp_data (struct device *,
60 /* Set the selection data to GDK_NONE and NULL data, meaning we were
61 ** unable to do what they wanted.
64 gtk_decline_selection_request (GtkSelectionData *data)
66 gtk_selection_data_set (data, GDK_NONE, 0, NULL, 0);
69 /* Used as an unwind-protect clause so that, if a selection-converter signals
70 an error, we tell the requestor that we were unable to do what they wanted
71 before we throw to top-level or go into the debugger or whatever.
73 struct _selection_closure
75 GtkSelectionData *data;
80 gtk_selection_request_lisp_error (Lisp_Object closure)
82 struct _selection_closure *cl = (struct _selection_closure *)
83 get_opaque_ptr (closure);
85 free_opaque_ptr (closure);
86 if (cl->successful == TRUE)
88 gtk_decline_selection_request (cl->data);
92 /* This provides the current selection to a requester.
94 ** This is connected to the selection_get() signal of the application
95 ** shell in device-gtk.c:gtk_init_device().
97 ** This is radically different than the old selection code (21.1.x),
98 ** but has been modeled after the X code, and appears to work.
103 emacs_gtk_selection_handle (GtkWidget *widget,
104 GtkSelectionData *selection_data,
109 /* This function can GC */
110 struct gcpro gcpro1, gcpro2;
111 Lisp_Object temp_obj;
112 Lisp_Object selection_symbol;
113 Lisp_Object target_symbol = Qnil;
114 Lisp_Object converted_selection = Qnil;
115 guint32 local_selection_time;
116 Lisp_Object successful_p = Qnil;
118 struct device *d = decode_gtk_device (Qnil);
119 struct _selection_closure *cl = NULL;
121 GCPRO2 (converted_selection, target_symbol);
123 selection_symbol = atom_to_symbol (d, selection_data->selection);
124 target_symbol = atom_to_symbol (d, selection_data->target);
126 #if 0 /* #### MULTIPLE doesn't work yet */
127 if (EQ (target_symbol, QMULTIPLE))
128 target_symbol = fetch_multiple_target (selection_data);
131 temp_obj = Fget_selection_timestamp (selection_symbol);
135 /* We don't appear to have the selection. */
136 gtk_decline_selection_request (selection_data);
141 local_selection_time = * (guint32 *) XOPAQUE_DATA (temp_obj);
143 if (time_stamp != GDK_CURRENT_TIME &&
144 local_selection_time > time_stamp)
146 /* Someone asked for the selection, and we have one, but not the one
147 they're looking for. */
148 gtk_decline_selection_request (selection_data);
152 converted_selection = select_convert_out (selection_symbol,
153 target_symbol, Qnil);
155 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
156 if (NILP (converted_selection))
158 /* We don't appear to have a selection in that data type. */
159 gtk_decline_selection_request (selection_data);
163 count = specpdl_depth ();
165 cl = (struct _selection_closure *) xmalloc (sizeof (*cl));
166 cl->data = selection_data;
167 cl->successful = FALSE;
169 record_unwind_protect (gtk_selection_request_lisp_error,
170 make_opaque_ptr (cl));
177 lisp_data_to_selection_data (d, converted_selection,
178 &data, &type, &size, &format);
180 gtk_selection_data_set (selection_data, type, format, data, size);
182 /* Tell x_selection_request_lisp_error() it's cool. */
183 cl->successful = TRUE;
187 unbind_to (count, Qnil);
195 /* Let random lisp code notice that the selection has been asked for. */
197 Lisp_Object val = Vgtk_sent_selection_hooks;
198 if (!UNBOUNDP (val) && !NILP (val))
201 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
202 for (rest = val; !NILP (rest); rest = Fcdr (rest))
203 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
205 call3 (val, selection_symbol, target_symbol, successful_p);
212 static GtkWidget *reading_selection_reply;
213 static GdkAtom reading_which_selection;
214 static int selection_reply_timed_out;
216 /* Gets the current selection owned by another application */
218 emacs_gtk_selection_received (GtkWidget *widget,
219 GtkSelectionData *selection_data,
222 waiting_for_selection = FALSE;
223 Vretrieved_selection = Qnil;
225 reading_selection_reply = NULL;
227 signal_fake_event ();
229 if (selection_data->length < 0)
234 Vretrieved_selection =
235 selection_data_to_lisp_data (NULL,
236 selection_data->data,
237 selection_data->length,
238 selection_data->type,
239 selection_data->format);
243 selection_reply_done (void *ignore)
245 return !reading_selection_reply;
248 /* Do protocol to read selection-data from the server.
249 Converts this to lisp data and returns it.
252 gtk_get_foreign_selection (Lisp_Object selection_symbol,
253 Lisp_Object target_type)
255 /* This function can GC */
256 struct device *d = decode_gtk_device (Qnil);
257 GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d);
258 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d);
259 GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0);
261 GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ?
262 XCAR (target_type) : target_type), 0);
264 gtk_selection_convert (requestor, selection_atom, type_atom,
267 signal_fake_event ();
269 /* Block until the reply has been read. */
270 reading_selection_reply = requestor;
271 reading_which_selection = selection_atom;
272 selection_reply_timed_out = 0;
274 speccount = specpdl_depth ();
277 /* add a timeout handler */
278 if (gtk_selection_timeout > 0)
280 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
281 Qx_selection_reply_timeout_internal,
283 record_unwind_protect (Fdisable_timeout, id);
288 wait_delaying_user_input (selection_reply_done, 0);
290 if (selection_reply_timed_out)
291 error ("timed out waiting for reply from selection owner");
293 unbind_to (speccount, Qnil);
295 /* otherwise, the selection is waiting for us on the requested property. */
296 return select_convert_in (selection_symbol,
298 Vretrieved_selection);
304 gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property,
305 Extbyte **data_ret, int *bytes_ret,
306 GdkAtom *actual_type_ret, int *actual_format_ret,
307 unsigned long *actual_size_ret, int delete_p)
310 unsigned long bytes_remaining;
312 unsigned char *tmp_data = 0;
314 int buffer_size = SELECTION_QUANTUM (display);
315 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
317 /* First probe the thing to find out how big it is. */
318 result = XGetWindowProperty (display, window, property,
319 0, 0, False, AnyPropertyType,
320 actual_type_ret, actual_format_ret,
322 &bytes_remaining, &tmp_data);
323 if (result != Success)
329 XFree ((char *) tmp_data);
331 if (*actual_type_ret == None || *actual_format_ret == 0)
333 if (delete_p) XDeleteProperty (display, window, property);
339 total_size = bytes_remaining + 1;
340 *data_ret = (Extbyte *) xmalloc (total_size);
342 /* Now read, until we've gotten it all. */
343 while (bytes_remaining)
346 int last = bytes_remaining;
349 XGetWindowProperty (display, window, property,
350 offset/4, buffer_size/4,
351 (delete_p ? True : False),
353 actual_type_ret, actual_format_ret,
354 actual_size_ret, &bytes_remaining, &tmp_data);
356 stderr_out ("<< read %d\n", last-bytes_remaining);
358 /* If this doesn't return Success at this point, it means that
359 some clod deleted the selection while we were in the midst of
360 reading it. Deal with that, I guess....
362 if (result != Success) break;
363 *actual_size_ret *= *actual_format_ret / 8;
364 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
365 offset += *actual_size_ret;
366 XFree ((char *) tmp_data);
373 receive_incremental_selection (Display *display, Window window, Atom property,
374 /* this one is for error messages only */
375 Lisp_Object target_type,
376 unsigned int min_size_bytes,
377 Extbyte **data_ret, int *size_bytes_ret,
378 Atom *type_ret, int *format_ret,
379 unsigned long *size_ret)
381 /* This function can GC */
384 *size_bytes_ret = min_size_bytes;
385 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
387 stderr_out ("\nread INCR %d\n", min_size_bytes);
389 /* At this point, we have read an INCR property, and deleted it (which
390 is how we ack its receipt: the sending window will be selecting
391 PropertyNotify events on our window to notice this).
393 Now, we must loop, waiting for the sending window to put a value on
394 that property, then reading the property, then deleting it to ack.
395 We are done when the sender places a property of length 0.
397 prop_id = expect_property_change (display, window, property,
403 wait_for_property_change (prop_id);
404 /* expect it again immediately, because x_get_window_property may
405 .. no it won't, I don't get it.
406 .. Ok, I get it now, the Xt code that implements INCR is broken.
408 prop_id = expect_property_change (display, window, property,
410 x_get_window_property (display, window, property,
411 &tmp_data, &tmp_size_bytes,
412 type_ret, format_ret, size_ret, 1);
414 if (tmp_size_bytes == 0) /* we're done */
417 stderr_out (" read INCR done\n");
419 unexpect_property_change (prop_id);
420 if (tmp_data) xfree (tmp_data);
424 stderr_out (" read INCR %d\n", tmp_size_bytes);
426 if (*size_bytes_ret < offset + tmp_size_bytes)
429 stderr_out (" read INCR realloc %d -> %d\n",
430 *size_bytes_ret, offset + tmp_size_bytes);
432 *size_bytes_ret = offset + tmp_size_bytes;
433 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
435 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
436 offset += tmp_size_bytes;
443 gtk_get_window_property_as_lisp_data (struct device *d,
446 /* next two for error messages only */
447 Lisp_Object target_type,
448 GdkAtom selection_atom)
450 /* This function can GC */
453 unsigned long actual_size;
454 Extbyte *data = NULL;
457 struct device *d = get_device_from_display (display);
459 x_get_window_property (display, window, property, &data, &bytes,
460 &actual_type, &actual_format, &actual_size, 1);
463 if (XGetSelectionOwner (display, selection_atom))
464 /* there is a selection owner */
466 (Qselection_conversion_error,
467 Fcons (build_string ("selection owner couldn't convert"),
468 Fcons (x_atom_to_symbol (d, selection_atom),
470 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
471 list1 (target_type))));
473 signal_error (Qerror,
474 list2 (build_string ("no selection"),
475 x_atom_to_symbol (d, selection_atom)));
478 if (actual_type == DEVICE_XATOM_INCR (d))
480 /* Ok, that data wasn't *the* data, it was just the beginning. */
482 unsigned int min_size_bytes = * ((unsigned int *) data);
484 receive_incremental_selection (display, window, property, target_type,
485 min_size_bytes, &data, &bytes,
486 &actual_type, &actual_format,
490 /* It's been read. Now convert it to a lisp object in some semi-rational
492 val = selection_data_to_lisp_data (d, data, bytes,
493 actual_type, actual_format);
502 symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists)
504 if (NILP (sym)) return GDK_SELECTION_PRIMARY;
505 if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY;
506 if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY;
507 if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY;
511 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
512 return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE);
517 atom_to_symbol (struct device *d, GdkAtom atom)
519 if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY);
520 if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY);
524 char *str = gdk_atom_name (atom);
526 if (! str) return Qnil;
528 TO_INTERNAL_FORMAT (C_STRING, str,
529 C_STRING_ALLOCA, intstr,
532 return intern (intstr);
536 /* #### These are going to move into Lisp code(!) with the aid of
537 some new functions I'm working on - ajh */
539 /* These functions convert from the selection data read from the server into
540 something that we can use from elisp, and vice versa.
542 Type: Format: Size: Elisp Type:
543 ----- ------- ----- -----------
546 ATOM 32 > 1 Vector of Symbols
548 * 16 > 1 Vector of Integers
549 * 32 1 if <=16 bits: Integer
550 if > 16 bits: Cons of top16, bot16
551 * 32 > 1 Vector of the above
553 When converting a Lisp number to C, it is assumed to be of format 16 if
554 it is an integer, and of format 32 if it is a cons of two integers.
556 When converting a vector of numbers from Elisp to C, it is assumed to be
557 of format 16 if every element in the vector is an integer, and is assumed
558 to be of format 32 if any element is a cons of two integers.
560 When converting an object to C, it may be of the form (SYMBOL . <data>)
561 where SYMBOL is what we should claim that the type is. Format and
562 representation are as above.
564 NOTE: Under Mule, when someone shoves us a string without a type, we
565 set the type to 'COMPOUND_TEXT and automatically convert to Compound
566 Text. If the string has a type, we assume that the user wants the
567 data sent as-is so we just do "binary" conversion.
572 selection_data_to_lisp_data (struct device *d,
578 if (type == gdk_atom_intern ("NULL", 0))
581 /* Convert any 8-bit data to a string, for compactness. */
582 else if (format == 8)
583 return make_ext_string (data, size,
584 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
585 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
588 /* Convert a single atom to a Lisp Symbol.
589 Convert a set of atoms to a vector of symbols. */
590 else if (type == gdk_atom_intern ("ATOM", FALSE))
592 if (size == sizeof (GdkAtom))
593 return atom_to_symbol (d, *((GdkAtom *) data));
597 int len = size / sizeof (GdkAtom);
598 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
599 for (i = 0; i < len; i++)
600 Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i]));
605 /* Convert a single 16 or small 32 bit number to a Lisp Int.
606 If the number is > 16 bits, convert it to a cons of integers,
607 16 bits in each half.
609 else if (format == 32 && size == sizeof (long))
610 return word_to_lisp (((unsigned long *) data) [0]);
611 else if (format == 16 && size == sizeof (short))
612 return make_int ((int) (((unsigned short *) data) [0]));
614 /* Convert any other kind of data to a vector of numbers, represented
615 as above (as an integer, or a cons of two 16 bit integers).
617 #### Perhaps we should return the actual type to lisp as well.
619 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
622 and perhaps it should be
624 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
627 Right now the fact that the return type was SPAN is discarded before
628 lisp code gets to see it.
630 else if (format == 16)
633 Lisp_Object v = make_vector (size / 4, Qzero);
634 for (i = 0; i < (int) size / 4; i++)
636 int j = (int) ((unsigned short *) data) [i];
637 Faset (v, make_int (i), make_int (j));
644 Lisp_Object v = make_vector (size / 4, Qzero);
645 for (i = 0; i < (int) size / 4; i++)
647 unsigned long j = ((unsigned long *) data) [i];
648 Faset (v, make_int (i), word_to_lisp (j));
656 lisp_data_to_selection_data (struct device *d,
658 unsigned char **data_ret,
660 unsigned int *size_ret,
663 Lisp_Object type = Qnil;
665 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
669 if (CONSP (obj) && NILP (XCDR (obj)))
673 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
674 { /* This is not the same as declining */
680 else if (STRINGP (obj))
682 const Extbyte *extval;
685 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
686 ALLOCA, (extval, extvallen),
687 (NILP (type) ? Qctext : Qbinary));
689 *size_ret = extvallen;
690 *data_ret = (unsigned char *) xmalloc (*size_ret);
691 memcpy (*data_ret, extval, *size_ret);
693 if (NILP (type)) type = QCOMPOUND_TEXT;
695 if (NILP (type)) type = QSTRING;
698 else if (CHARP (obj))
700 Bufbyte buf[MAX_EMCHAR_LEN];
702 const Extbyte *extval;
706 len = set_charptr_emchar (buf, XCHAR (obj));
707 TO_EXTERNAL_FORMAT (DATA, (buf, len),
708 ALLOCA, (extval, extvallen),
710 *size_ret = extvallen;
711 *data_ret = (unsigned char *) xmalloc (*size_ret);
712 memcpy (*data_ret, extval, *size_ret);
714 if (NILP (type)) type = QCOMPOUND_TEXT;
716 if (NILP (type)) type = QSTRING;
719 else if (SYMBOLP (obj))
723 *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1);
724 (*data_ret) [sizeof (GdkAtom)] = 0;
725 (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0);
726 if (NILP (type)) type = QATOM;
728 else if (INTP (obj) &&
729 XINT (obj) <= 0x7FFF &&
730 XINT (obj) >= -0x8000)
734 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
735 (*data_ret) [sizeof (short)] = 0;
736 (*(short **) data_ret) [0] = (short) XINT (obj);
737 if (NILP (type)) type = QINTEGER;
739 else if (INTP (obj) || CONSP (obj))
743 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
744 (*data_ret) [sizeof (long)] = 0;
745 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
746 if (NILP (type)) type = QINTEGER;
748 else if (VECTORP (obj))
750 /* Lisp Vectors may represent a set of ATOMs;
751 a set of 16 or 32 bit INTEGERs;
752 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
756 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
757 /* This vector is an ATOM set */
759 if (NILP (type)) type = QATOM;
760 *size_ret = XVECTOR_LENGTH (obj);
762 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom));
763 for (i = 0; i < (int) (*size_ret); i++)
764 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
765 (*(GdkAtom **) data_ret) [i] =
766 symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0);
768 signal_error (Qerror, /* Qselection_error */
770 ("all elements of the vector must be of the same type"),
773 #if 0 /* #### MULTIPLE doesn't work yet */
774 else if (VECTORP (XVECTOR_DATA (obj) [0]))
775 /* This vector is an ATOM_PAIR set */
777 if (NILP (type)) type = QATOM_PAIR;
778 *size_ret = XVECTOR_LENGTH (obj);
780 *data_ret = (unsigned char *)
781 xmalloc ((*size_ret) * sizeof (Atom) * 2);
782 for (i = 0; i < *size_ret; i++)
783 if (VECTORP (XVECTOR_DATA (obj) [i]))
785 Lisp_Object pair = XVECTOR_DATA (obj) [i];
786 if (XVECTOR_LENGTH (pair) != 2)
787 signal_error (Qerror,
789 ("elements of the vector must be vectors of exactly two elements"),
792 (*(GdkAtom **) data_ret) [i * 2] =
793 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0);
794 (*(GdkAtom **) data_ret) [(i * 2) + 1] =
795 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0);
798 signal_error (Qerror,
800 ("all elements of the vector must be of the same type"),
805 /* This vector is an INTEGER set, or something like it */
807 *size_ret = XVECTOR_LENGTH (obj);
808 if (NILP (type)) type = QINTEGER;
810 for (i = 0; i < (int) (*size_ret); i++)
811 if (CONSP (XVECTOR_DATA (obj) [i]))
813 else if (!INTP (XVECTOR_DATA (obj) [i]))
814 signal_error (Qerror, /* Qselection_error */
816 ("all elements of the vector must be integers or conses of integers"),
819 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
820 for (i = 0; i < (int) (*size_ret); i++)
821 if (*format_ret == 32)
822 (*((unsigned long **) data_ret)) [i] =
823 lisp_to_word (XVECTOR_DATA (obj) [i]);
825 (*((unsigned short **) data_ret)) [i] =
826 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
830 signal_error (Qerror, /* Qselection_error */
831 list2 (build_string ("unrecognized selection data"),
834 *type_ret = symbol_to_gtk_atom (d, type, 0);
840 gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
841 Lisp_Object how_to_add, Lisp_Object selection_type)
843 struct device *d = decode_gtk_device (Qnil);
844 GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
845 Lisp_Object selection_time;
846 /* Use the time of the last-read mouse or keyboard event.
847 For selection purposes, we use this as a sleazy way of knowing what the
848 current time is in server-time. This assumes that the most recently read
849 mouse or keyboard event has something to do with the assertion of the
850 selection, which is probably true.
852 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d);
853 GdkAtom selection_atom;
855 CHECK_SYMBOL (selection_name);
856 selection_atom = symbol_to_gtk_atom (d, selection_name, 0);
858 gtk_selection_owner_set (selecting_window,
862 /* We do NOT use time_to_lisp() here any more, like we used to.
863 That assumed equivalence of time_t and Time, which is not
864 necessarily the case (e.g. under OSF on the Alphas, where
865 Time is a 64-bit quantity and time_t is a 32-bit quantity).
867 Opaque pointers are the clean way to go here.
869 selection_time = make_opaque (&thyme, sizeof (thyme));
871 return selection_time;
875 gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval)
877 struct device *d = decode_gtk_device (Qnil);
878 GdkAtom selection_atom;
881 CHECK_SYMBOL (selection);
882 selection_atom = symbol_to_gtk_atom (d, selection, 0);
885 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d);
889 lisp_to_time (timeval, &the_time);
890 timestamp = (guint32) the_time;
893 gtk_selection_owner_set (NULL, selection_atom, timestamp);
897 gtk_selection_exists_p (Lisp_Object selection,
898 Lisp_Object selection_type)
900 struct device *d = decode_gtk_device (Qnil);
902 return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil);
907 /************************************************************************/
909 /************************************************************************/
912 syms_of_select_gtk (void)
917 console_type_create_select_gtk (void)
919 CONSOLE_HAS_METHOD (gtk, own_selection);
920 CONSOLE_HAS_METHOD (gtk, disown_selection);
921 CONSOLE_HAS_METHOD (gtk, selection_exists_p);
922 CONSOLE_HAS_METHOD (gtk, get_foreign_selection);
926 vars_of_select_gtk (void)
928 staticpro (&Vretrieved_selection);
929 Vretrieved_selection = Qnil;
931 DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
932 A function or functions to be called after we have responded to some
933 other client's request for the value of a selection that we own. The
934 function(s) will be called with four arguments:
935 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
936 - the name of the selection-type which we were requested to convert the
937 selection into before sending (for example, STRING or LENGTH);
938 - and whether we successfully transmitted the selection.
939 We might have failed (and declined the request) for any number of reasons,
940 including being asked for a selection that we no longer own, or being asked
941 to convert into a type that we don't know about or that is inappropriate.
942 This hook doesn't let you change the behavior of emacs's selection replies,
943 it merely informs you that they have happened.
945 Vgtk_sent_selection_hooks = Qunbound;