1 /* GTK selection processing for SXEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: Not synched with FSF. */
24 Written by Kevin Gallo for FSF Emacs.
25 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
26 Rewritten for GTK by William Perry, April 2000 for 21.1
31 #include "events/events.h"
33 #include "ui/device.h"
34 #include "console-gtk.h"
35 #include "ui/select.h"
39 int lisp_to_time(Lisp_Object, time_t *);
40 static Lisp_Object Vretrieved_selection;
41 static gboolean waiting_for_selection;
42 Lisp_Object Vgtk_sent_selection_hooks;
44 static Lisp_Object atom_to_symbol(struct device *d, GdkAtom atom);
45 static GdkAtom symbol_to_gtk_atom(struct device *d, Lisp_Object sym,
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 *,
57 GdkAtom type, int format);
59 /* Set the selection data to GDK_NONE and NULL data, meaning we were
60 ** unable to do what they wanted.
62 static void gtk_decline_selection_request(GtkSelectionData * data)
64 gtk_selection_data_set(data, GDK_NONE, 0, NULL, 0);
67 /* Used as an unwind-protect clause so that, if a selection-converter signals
68 an error, we tell the requestor that we were unable to do what they wanted
69 before we throw to top-level or go into the debugger or whatever.
71 struct _selection_closure {
72 GtkSelectionData *data;
76 static Lisp_Object gtk_selection_request_lisp_error(Lisp_Object closure)
78 struct _selection_closure *cl = (struct _selection_closure *)
79 get_opaque_ptr(closure);
81 free_opaque_ptr(closure);
82 if (cl->successful == TRUE)
84 gtk_decline_selection_request(cl->data);
88 /* This provides the current selection to a requester.
90 ** This is connected to the selection_get() signal of the application
91 ** shell in device-gtk.c:gtk_init_device().
93 ** This is radically different than the old selection code (21.1.x),
94 ** but has been modeled after the X code, and appears to work.
99 emacs_gtk_selection_handle(GtkWidget * widget,
100 GtkSelectionData * selection_data,
101 guint info, guint time_stamp, gpointer data)
103 /* This function can GC */
104 struct gcpro gcpro1, gcpro2;
105 Lisp_Object temp_obj;
106 Lisp_Object selection_symbol;
107 Lisp_Object target_symbol = Qnil;
108 Lisp_Object converted_selection = Qnil;
109 guint32 local_selection_time;
110 Lisp_Object successful_p = Qnil;
112 struct device *d = decode_gtk_device(Qnil);
113 struct _selection_closure *cl = NULL;
115 GCPRO2(converted_selection, target_symbol);
117 selection_symbol = atom_to_symbol(d, selection_data->selection);
118 target_symbol = atom_to_symbol(d, selection_data->target);
120 #if 0 /* #### MULTIPLE doesn't work yet */
121 if (EQ(target_symbol, QMULTIPLE))
122 target_symbol = fetch_multiple_target(selection_data);
125 temp_obj = Fget_selection_timestamp(selection_symbol);
127 if (NILP(temp_obj)) {
128 /* We don't appear to have the selection. */
129 gtk_decline_selection_request(selection_data);
134 local_selection_time = *(guint32 *) XOPAQUE_DATA(temp_obj);
136 if (time_stamp != GDK_CURRENT_TIME && local_selection_time > time_stamp) {
137 /* Someone asked for the selection, and we have one, but not the one
138 they're looking for. */
139 gtk_decline_selection_request(selection_data);
143 converted_selection = select_convert_out(selection_symbol,
144 target_symbol, Qnil);
146 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
147 if (NILP(converted_selection)) {
148 /* We don't appear to have a selection in that data type. */
149 gtk_decline_selection_request(selection_data);
153 count = specpdl_depth();
155 cl = (struct _selection_closure *)xmalloc(sizeof(*cl));
156 cl->data = selection_data;
157 cl->successful = FALSE;
159 record_unwind_protect(gtk_selection_request_lisp_error,
160 make_opaque_ptr(cl));
167 lisp_data_to_selection_data(d, converted_selection,
168 &data, &type, &size, &format);
170 gtk_selection_data_set(selection_data, type, format, data,
173 /* Tell x_selection_request_lisp_error() it's cool. */
174 cl->successful = TRUE;
178 unbind_to(count, Qnil);
187 /* Let random lisp code notice that the selection has been asked for. */
189 Lisp_Object val = Vgtk_sent_selection_hooks;
190 if (!UNBOUNDP(val) && !NILP(val)) {
192 if (CONSP(val) && !EQ(XCAR(val), Qlambda))
193 for (rest = val; !NILP(rest); rest = Fcdr(rest))
194 call3(Fcar(rest), selection_symbol,
195 target_symbol, successful_p);
197 call3(val, selection_symbol, target_symbol,
204 emacs_gtk_selection_clear_event_handle(GtkWidget * widget,
205 GdkEventSelection * event, gpointer data)
207 GdkAtom selection = event->selection;
208 guint32 changed_owner_time = event->time;
209 struct device *d = decode_gtk_device(Qnil);
211 Lisp_Object selection_symbol, local_selection_time_lisp;
212 guint32 local_selection_time;
214 selection_symbol = atom_to_symbol(d, selection);
216 local_selection_time_lisp = Fget_selection_timestamp(selection_symbol);
218 /* We don't own the selection, so that's fine. */
219 if (NILP(local_selection_time_lisp))
222 local_selection_time =
223 *(guint32 *) XOPAQUE_DATA(local_selection_time_lisp);
225 /* This SelectionClear is for a selection that we no longer own, so we can
226 disregard it. (That is, we have reasserted the selection since this
227 request was generated.)
229 if (changed_owner_time != GDK_CURRENT_TIME &&
230 local_selection_time > changed_owner_time)
233 handle_selection_clear(selection_symbol);
236 static GtkWidget *reading_selection_reply;
237 static GdkAtom reading_which_selection;
238 static int selection_reply_timed_out;
240 /* Gets the current selection owned by another application */
242 emacs_gtk_selection_received(GtkWidget * widget,
243 GtkSelectionData * selection_data,
246 waiting_for_selection = FALSE;
247 Vretrieved_selection = Qnil;
249 reading_selection_reply = NULL;
253 if (selection_data->length < 0) {
257 Vretrieved_selection =
258 selection_data_to_lisp_data(NULL,
259 selection_data->data,
260 selection_data->length,
261 selection_data->type,
262 selection_data->format);
265 static int selection_reply_done(void *ignore)
267 return !reading_selection_reply;
270 /* Do protocol to read selection-data from the server.
271 Converts this to lisp data and returns it.
274 gtk_get_foreign_selection(Lisp_Object selection_symbol, Lisp_Object target_type)
276 /* This function can GC */
277 struct device *d = decode_gtk_device(Qnil);
278 GtkWidget *requestor = DEVICE_GTK_APP_SHELL(d);
279 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP(d);
280 GdkAtom selection_atom = symbol_to_gtk_atom(d, selection_symbol, 0);
282 GdkAtom type_atom = symbol_to_gtk_atom(d, (CONSP(target_type) ?
286 gtk_selection_convert(requestor, selection_atom, type_atom,
291 /* Block until the reply has been read. */
292 reading_selection_reply = requestor;
293 reading_which_selection = selection_atom;
294 selection_reply_timed_out = 0;
296 speccount = specpdl_depth();
299 /* add a timeout handler */
300 if (gtk_selection_timeout > 0) {
301 Lisp_Object id = Fadd_timeout(make_int(x_selection_timeout),
302 Qx_selection_reply_timeout_internal,
304 record_unwind_protect(Fdisable_timeout, id);
309 wait_delaying_user_input(selection_reply_done, 0);
311 if (selection_reply_timed_out)
312 error("timed out waiting for reply from selection owner");
314 unbind_to(speccount, Qnil);
316 /* otherwise, the selection is waiting for us on the requested property. */
317 return select_convert_in(selection_symbol,
318 target_type, Vretrieved_selection);
323 gtk_get_window_property(struct device *d, GtkWidget * window, GdkAtom property,
324 Extbyte ** data_ret, int *bytes_ret,
325 GdkAtom * actual_type_ret, int *actual_format_ret,
326 unsigned long *actual_size_ret, int delete_p)
329 unsigned long bytes_remaining;
331 unsigned char *tmp_data = 0;
333 int buffer_size = SELECTION_QUANTUM(display);
334 if (buffer_size > MAX_SELECTION_QUANTUM)
335 buffer_size = MAX_SELECTION_QUANTUM;
337 /* First probe the thing to find out how big it is. */
338 result = XGetWindowProperty(display, window, property,
339 0, 0, False, AnyPropertyType,
340 actual_type_ret, actual_format_ret,
342 &bytes_remaining, &tmp_data);
343 if (result != Success) {
348 XFree((char *)tmp_data);
350 if (*actual_type_ret == None || *actual_format_ret == 0) {
352 XDeleteProperty(display, window, property);
358 total_size = bytes_remaining + 1;
359 *data_ret = (Extbyte *) xmalloc(total_size);
361 /* Now read, until we've gotten it all. */
362 while (bytes_remaining) {
364 int last = bytes_remaining;
367 XGetWindowProperty(display, window, property,
368 offset / 4, buffer_size / 4,
369 (delete_p ? True : False),
371 actual_type_ret, actual_format_ret,
372 actual_size_ret, &bytes_remaining,
375 stderr_out("<< read %d\n", last - bytes_remaining);
377 /* If this doesn't return Success at this point, it means that
378 some clod deleted the selection while we were in the midst of
379 reading it. Deal with that, I guess....
381 if (result != Success)
383 *actual_size_ret *= *actual_format_ret / 8;
384 memcpy((*data_ret) + offset, tmp_data, *actual_size_ret);
385 offset += *actual_size_ret;
386 XFree((char *)tmp_data);
392 receive_incremental_selection(Display * display, Window window, Atom property,
393 /* this one is for error messages only */
394 Lisp_Object target_type,
395 unsigned int min_size_bytes,
396 Extbyte ** data_ret, int *size_bytes_ret,
397 Atom * type_ret, int *format_ret,
398 unsigned long *size_ret)
400 /* This function can GC */
403 *size_bytes_ret = min_size_bytes;
404 *data_ret = (Extbyte *) xmalloc(*size_bytes_ret);
406 stderr_out("\nread INCR %d\n", min_size_bytes);
408 /* At this point, we have read an INCR property, and deleted it (which
409 is how we ack its receipt: the sending window will be selecting
410 PropertyNotify events on our window to notice this).
412 Now, we must loop, waiting for the sending window to put a value on
413 that property, then reading the property, then deleting it to ack.
414 We are done when the sender places a property of length 0.
416 prop_id = expect_property_change(display, window, property,
421 wait_for_property_change(prop_id);
422 /* expect it again immediately, because x_get_window_property may
423 .. no it won't, I don't get it.
424 .. Ok, I get it now, the Xt code that implements INCR is broken.
426 prop_id = expect_property_change(display, window, property,
428 x_get_window_property(display, window, property,
429 &tmp_data, &tmp_size_bytes,
430 type_ret, format_ret, size_ret, 1);
432 if (tmp_size_bytes == 0) { /* we're done */
434 stderr_out(" read INCR done\n");
436 unexpect_property_change(prop_id);
442 stderr_out(" read INCR %d\n", tmp_size_bytes);
444 if (*size_bytes_ret < offset + tmp_size_bytes) {
446 stderr_out(" read INCR realloc %d -> %d\n",
447 *size_bytes_ret, offset + tmp_size_bytes);
449 *size_bytes_ret = offset + tmp_size_bytes;
451 (Extbyte *) xrealloc(*data_ret, *size_bytes_ret);
453 memcpy((*data_ret) + offset, tmp_data, tmp_size_bytes);
454 offset += tmp_size_bytes;
460 gtk_get_window_property_as_lisp_data(struct device *d,
461 GtkWidget * window, GdkAtom property,
462 /* next two for error messages only */
463 Lisp_Object target_type,
464 GdkAtom selection_atom)
466 /* This function can GC */
469 unsigned long actual_size;
470 Extbyte *data = NULL;
473 struct device *d = get_device_from_display(display);
475 x_get_window_property(display, window, property, &data, &bytes,
476 &actual_type, &actual_format, &actual_size, 1);
478 if (XGetSelectionOwner(display, selection_atom))
479 /* there is a selection owner */
481 (Qselection_conversion_error,
483 ("selection owner couldn't convert"),
484 Fcons(x_atom_to_symbol(d, selection_atom),
485 actual_type ? list2(target_type,
488 : list1(target_type))));
491 list2(build_string("no selection"),
496 if (actual_type == DEVICE_XATOM_INCR(d)) {
497 /* Ok, that data wasn't *the* data, it was just the beginning. */
499 unsigned int min_size_bytes = *((unsigned int *)data);
501 receive_incremental_selection(display, window, property,
502 target_type, min_size_bytes,
503 &data, &bytes, &actual_type,
504 &actual_format, &actual_size);
507 /* It's been read. Now convert it to a lisp object in some semi-rational
509 val = selection_data_to_lisp_data(d, data, bytes,
510 actual_type, actual_format);
518 symbol_to_gtk_atom(struct device *d, Lisp_Object sym, int only_if_exists)
521 return GDK_SELECTION_PRIMARY;
523 return GDK_SELECTION_SECONDARY;
524 if (EQ(sym, QPRIMARY))
525 return GDK_SELECTION_PRIMARY;
526 if (EQ(sym, QSECONDARY))
527 return GDK_SELECTION_SECONDARY;
531 LISP_STRING_TO_EXTERNAL(Fsymbol_name(sym), nameext, Qctext);
532 return gdk_atom_intern(nameext, only_if_exists ? TRUE : FALSE);
536 static Lisp_Object atom_to_symbol(struct device *d, GdkAtom atom)
538 if (atom == GDK_SELECTION_PRIMARY)
540 if (atom == GDK_SELECTION_SECONDARY)
545 char *str = gdk_atom_name(atom);
550 TO_INTERNAL_FORMAT(C_STRING, str,
551 C_STRING_ALLOCA, intstr, Qctext);
553 return intern(intstr);
557 /* #### These are going to move into Lisp code(!) with the aid of
558 some new functions I'm working on - ajh */
560 /* These functions convert from the selection data read from the server into
561 something that we can use from elisp, and vice versa.
563 Type: Format: Size: Elisp Type:
564 ----- ------- ----- -----------
567 ATOM 32 > 1 Vector of Symbols
569 * 16 > 1 Vector of Integers
570 * 32 1 if <=16 bits: Integer
571 if > 16 bits: Cons of top16, bot16
572 * 32 > 1 Vector of the above
574 When converting a Lisp number to C, it is assumed to be of format 16 if
575 it is an integer, and of format 32 if it is a cons of two integers.
577 When converting a vector of numbers from Elisp to C, it is assumed to be
578 of format 16 if every element in the vector is an integer, and is assumed
579 to be of format 32 if any element is a cons of two integers.
581 When converting an object to C, it may be of the form (SYMBOL . <data>)
582 where SYMBOL is what we should claim that the type is. Format and
583 representation are as above.
585 NOTE: Under Mule, when someone shoves us a string without a type, we
586 set the type to 'COMPOUND_TEXT and automatically convert to Compound
587 Text. If the string has a type, we assume that the user wants the
588 data sent as-is so we just do "binary" conversion.
592 selection_data_to_lisp_data(struct device *d,
594 size_t size, GdkAtom type, int format)
596 if (type == gdk_atom_intern("NULL", 0))
599 /* Convert any 8-bit data to a string, for compactness. */
600 else if (format == 8)
601 return make_ext_string(data, size,
602 ((type == gdk_atom_intern("TEXT", FALSE))
604 gdk_atom_intern("COMPOUND_TEXT",
608 /* Convert a single atom to a Lisp Symbol.
609 Convert a set of atoms to a vector of symbols. */
610 else if (type == gdk_atom_intern("ATOM", FALSE)) {
611 if (size == sizeof(GdkAtom))
612 return atom_to_symbol(d, *((GdkAtom *) data));
615 int len = size / sizeof(GdkAtom);
616 Lisp_Object v = Fmake_vector(make_int(len), Qzero);
617 for (i = 0; i < len; i++)
618 Faset(v, make_int(i),
619 atom_to_symbol(d, ((GdkAtom *) data)[i]));
624 /* Convert a single 16 or small 32 bit number to a Lisp Int.
625 If the number is > 16 bits, convert it to a cons of integers,
626 16 bits in each half.
628 else if (format == 32 && size == sizeof(long))
629 return word_to_lisp(((unsigned long *)data)[0]);
630 else if (format == 16 && size == sizeof(short))
631 return make_int((int)(((unsigned short *)data)[0]));
633 /* Convert any other kind of data to a vector of numbers, represented
634 as above (as an integer, or a cons of two 16 bit integers).
636 #### Perhaps we should return the actual type to lisp as well.
638 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
641 and perhaps it should be
643 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
646 Right now the fact that the return type was SPAN is discarded before
647 lisp code gets to see it.
649 else if (format == 16) {
651 Lisp_Object v = make_vector(size / 4, Qzero);
652 for (i = 0; i < (int)size / 4; i++) {
653 int j = (int)((unsigned short *)data)[i];
654 Faset(v, make_int(i), make_int(j));
659 Lisp_Object v = make_vector(size / 4, Qzero);
660 for (i = 0; i < (int)size / 4; i++) {
661 unsigned long j = ((unsigned long *)data)[i];
662 Faset(v, make_int(i), word_to_lisp(j));
669 lisp_data_to_selection_data(struct device *d,
671 unsigned char **data_ret,
673 unsigned int *size_ret, int *format_ret)
675 Lisp_Object type = Qnil;
677 if (CONSP(obj) && SYMBOLP(XCAR(obj))) {
680 if (CONSP(obj) && NILP(XCDR(obj)))
684 if (EQ(obj, QNULL) || (EQ(type, QNULL))) { /* This is not the same as declining */
689 } else if (STRINGP(obj)) {
690 const Extbyte *extval;
693 TO_EXTERNAL_FORMAT(LISP_STRING, obj,
694 ALLOCA, (extval, extvallen),
695 (NILP(type) ? Qctext : Qbinary));
697 *size_ret = extvallen;
698 *data_ret = (unsigned char *)xmalloc(*size_ret);
699 memcpy(*data_ret, extval, *size_ret);
702 type = QCOMPOUND_TEXT;
707 } else if (CHARP(obj)) {
708 Bufbyte buf[MAX_EMCHAR_LEN];
710 const Extbyte *extval;
714 len = set_charptr_emchar(buf, XCHAR(obj));
715 TO_EXTERNAL_FORMAT(DATA, (buf, len),
716 ALLOCA, (extval, extvallen), Qctext);
717 *size_ret = extvallen;
718 *data_ret = (unsigned char *)xmalloc(*size_ret);
719 memcpy(*data_ret, extval, *size_ret);
722 type = QCOMPOUND_TEXT;
727 } else if (SYMBOLP(obj)) {
730 *data_ret = (unsigned char *)xmalloc(sizeof(GdkAtom) + 1);
731 (*data_ret)[sizeof(GdkAtom)] = 0;
732 (*(GdkAtom **) data_ret)[0] = symbol_to_gtk_atom(d, obj, 0);
735 } else if (INTP(obj) && XINT(obj) <= 0x7FFF && XINT(obj) >= -0x8000) {
738 *data_ret = (unsigned char *)xmalloc(sizeof(short) + 1);
739 (*data_ret)[sizeof(short)] = 0;
740 (*(short **)data_ret)[0] = (short)XINT(obj);
743 } else if (INTP(obj) || CONSP(obj)) {
746 *data_ret = (unsigned char *)xmalloc(sizeof(long) + 1);
747 (*data_ret)[sizeof(long)] = 0;
748 (*(unsigned long **)data_ret)[0] = lisp_to_word(obj);
751 } else if (VECTORP(obj)) {
752 /* Lisp Vectors may represent a set of ATOMs;
753 a set of 16 or 32 bit INTEGERs;
754 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
758 if (SYMBOLP(XVECTOR_DATA(obj)[0]))
759 /* This vector is an ATOM set */
763 *size_ret = XVECTOR_LENGTH(obj);
766 (unsigned char *)xmalloc((*size_ret) *
768 for (i = 0; i < (int)(*size_ret); i++)
769 if (SYMBOLP(XVECTOR_DATA(obj)[i]))
770 (*(GdkAtom **) data_ret)[i] =
771 symbol_to_gtk_atom(d,
775 signal_error(Qerror, /* Qselection_error */
777 ("all elements of the vector must be of the same type"),
780 #if 0 /* #### MULTIPLE doesn't work yet */
781 else if (VECTORP(XVECTOR_DATA(obj)[0]))
782 /* This vector is an ATOM_PAIR set */
786 *size_ret = XVECTOR_LENGTH(obj);
788 *data_ret = (unsigned char *)
789 xmalloc((*size_ret) * sizeof(Atom) * 2);
790 for (i = 0; i < *size_ret; i++)
791 if (VECTORP(XVECTOR_DATA(obj)[i])) {
792 Lisp_Object pair = XVECTOR_DATA(obj)[i];
793 if (XVECTOR_LENGTH(pair) != 2)
796 ("elements of the vector must be vectors of exactly two elements"),
799 (*(GdkAtom **) data_ret)[i * 2] =
800 symbol_to_gtk_atom(d,
803 (*(GdkAtom **) data_ret)[(i * 2) + 1] =
804 symbol_to_gtk_atom(d,
810 ("all elements of the vector must be of the same type"),
815 /* This vector is an INTEGER set, or something like it */
817 *size_ret = XVECTOR_LENGTH(obj);
821 for (i = 0; i < (int)(*size_ret); i++)
822 if (CONSP(XVECTOR_DATA(obj)[i]))
824 else if (!INTP(XVECTOR_DATA(obj)[i]))
825 signal_error(Qerror, /* Qselection_error */
827 ("all elements of the vector must be integers or conses of integers"),
831 (unsigned char *)xmalloc(*size_ret *
833 for (i = 0; i < (int)(*size_ret); i++)
834 if (*format_ret == 32)
835 (*((unsigned long **)data_ret))[i] =
836 lisp_to_word(XVECTOR_DATA(obj)[i]);
838 (*((unsigned short **)data_ret))[i] =
840 lisp_to_word(XVECTOR_DATA(obj)[i]);
843 signal_error(Qerror, /* Qselection_error */
844 list2(build_string("unrecognized selection data"),
847 *type_ret = symbol_to_gtk_atom(d, type, 0);
851 gtk_own_selection(Lisp_Object selection_name, Lisp_Object selection_value,
852 Lisp_Object how_to_add, Lisp_Object selection_type)
854 struct device *d = decode_gtk_device(Qnil);
855 GtkWidget *selecting_window = GTK_WIDGET(DEVICE_GTK_APP_SHELL(d));
856 Lisp_Object selection_time;
857 /* Use the time of the last-read mouse or keyboard event.
858 For selection purposes, we use this as a sleazy way of knowing what the
859 current time is in server-time. This assumes that the most recently read
860 mouse or keyboard event has something to do with the assertion of the
861 selection, which is probably true.
863 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP(d);
864 GdkAtom selection_atom;
866 CHECK_SYMBOL(selection_name);
867 selection_atom = symbol_to_gtk_atom(d, selection_name, 0);
869 gtk_selection_owner_set(selecting_window, selection_atom, thyme);
871 /* We do NOT use time_to_lisp() here any more, like we used to.
872 That assumed equivalence of time_t and Time, which is not
873 necessarily the case (e.g. under OSF on the Alphas, where
874 Time is a 64-bit quantity and time_t is a 32-bit quantity).
876 Opaque pointers are the clean way to go here.
878 selection_time = make_opaque(&thyme, sizeof(thyme));
880 return selection_time;
883 static void gtk_disown_selection(Lisp_Object selection, Lisp_Object timeval)
885 struct device *d = decode_gtk_device(Qnil);
886 GdkAtom selection_atom;
889 CHECK_SYMBOL(selection);
890 selection_atom = symbol_to_gtk_atom(d, selection, 0);
893 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP(d);
896 lisp_to_time(timeval, &the_time);
897 timestamp = (guint32) the_time;
900 gtk_selection_owner_set(NULL, selection_atom, timestamp);
904 gtk_selection_exists_p(Lisp_Object selection, Lisp_Object selection_type)
906 struct device *d = decode_gtk_device(Qnil);
908 return (gdk_selection_owner_get(symbol_to_gtk_atom(d, selection, 0)) ?
912 /************************************************************************/
914 /************************************************************************/
916 void syms_of_select_gtk(void)
920 void console_type_create_select_gtk(void)
922 CONSOLE_HAS_METHOD(gtk, own_selection);
923 CONSOLE_HAS_METHOD(gtk, disown_selection);
924 CONSOLE_HAS_METHOD(gtk, selection_exists_p);
925 CONSOLE_HAS_METHOD(gtk, get_foreign_selection);
928 void vars_of_select_gtk(void)
930 staticpro(&Vretrieved_selection);
931 Vretrieved_selection = Qnil;
933 DEFVAR_LISP("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
934 A function or functions to be called after we have responded to some
935 other client's request for the value of a selection that we own. The
936 function(s) will be called with four arguments:
937 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
938 - the name of the selection-type which we were requested to convert the
939 selection into before sending (for example, STRING or LENGTH);
940 - and whether we successfully transmitted the selection.
941 We might have failed (and declined the request) for any number of reasons,
942 including being asked for a selection that we no longer own, or being asked
943 to convert into a type that we don't know about or that is inappropriate.
944 This hook doesn't let you change the behavior of emacs's selection replies,
945 it merely informs you that they have happened.
947 Vgtk_sent_selection_hooks = Qunbound;