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 emacs_gtk_selection_clear_event_handle (GtkWidget *widget,
214 GdkEventSelection *event,
217 GdkAtom selection = event->selection;
218 guint32 changed_owner_time = event->time;
219 struct device *d = decode_gtk_device (Qnil);
221 Lisp_Object selection_symbol, local_selection_time_lisp;
222 guint32 local_selection_time;
224 selection_symbol = atom_to_symbol (d, selection);
226 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
228 /* We don't own the selection, so that's fine. */
229 if (NILP (local_selection_time_lisp))
232 local_selection_time = *(guint32 *) XOPAQUE_DATA (local_selection_time_lisp);
234 /* This SelectionClear is for a selection that we no longer own, so we can
235 disregard it. (That is, we have reasserted the selection since this
236 request was generated.)
238 if (changed_owner_time != GDK_CURRENT_TIME &&
239 local_selection_time > changed_owner_time)
242 handle_selection_clear (selection_symbol);
247 static GtkWidget *reading_selection_reply;
248 static GdkAtom reading_which_selection;
249 static int selection_reply_timed_out;
251 /* Gets the current selection owned by another application */
253 emacs_gtk_selection_received (GtkWidget *widget,
254 GtkSelectionData *selection_data,
257 waiting_for_selection = FALSE;
258 Vretrieved_selection = Qnil;
260 reading_selection_reply = NULL;
262 signal_fake_event ();
264 if (selection_data->length < 0)
269 Vretrieved_selection =
270 selection_data_to_lisp_data (NULL,
271 selection_data->data,
272 selection_data->length,
273 selection_data->type,
274 selection_data->format);
278 selection_reply_done (void *ignore)
280 return !reading_selection_reply;
283 /* Do protocol to read selection-data from the server.
284 Converts this to lisp data and returns it.
287 gtk_get_foreign_selection (Lisp_Object selection_symbol,
288 Lisp_Object target_type)
290 /* This function can GC */
291 struct device *d = decode_gtk_device (Qnil);
292 GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d);
293 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d);
294 GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0);
296 GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ?
297 XCAR (target_type) : target_type), 0);
299 gtk_selection_convert (requestor, selection_atom, type_atom,
302 signal_fake_event ();
304 /* Block until the reply has been read. */
305 reading_selection_reply = requestor;
306 reading_which_selection = selection_atom;
307 selection_reply_timed_out = 0;
309 speccount = specpdl_depth ();
312 /* add a timeout handler */
313 if (gtk_selection_timeout > 0)
315 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
316 Qx_selection_reply_timeout_internal,
318 record_unwind_protect (Fdisable_timeout, id);
323 wait_delaying_user_input (selection_reply_done, 0);
325 if (selection_reply_timed_out)
326 error ("timed out waiting for reply from selection owner");
328 unbind_to (speccount, Qnil);
330 /* otherwise, the selection is waiting for us on the requested property. */
331 return select_convert_in (selection_symbol,
333 Vretrieved_selection);
339 gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property,
340 Extbyte **data_ret, int *bytes_ret,
341 GdkAtom *actual_type_ret, int *actual_format_ret,
342 unsigned long *actual_size_ret, int delete_p)
345 unsigned long bytes_remaining;
347 unsigned char *tmp_data = 0;
349 int buffer_size = SELECTION_QUANTUM (display);
350 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
352 /* First probe the thing to find out how big it is. */
353 result = XGetWindowProperty (display, window, property,
354 0, 0, False, AnyPropertyType,
355 actual_type_ret, actual_format_ret,
357 &bytes_remaining, &tmp_data);
358 if (result != Success)
364 XFree ((char *) tmp_data);
366 if (*actual_type_ret == None || *actual_format_ret == 0)
368 if (delete_p) XDeleteProperty (display, window, property);
374 total_size = bytes_remaining + 1;
375 *data_ret = (Extbyte *) xmalloc (total_size);
377 /* Now read, until we've gotten it all. */
378 while (bytes_remaining)
381 int last = bytes_remaining;
384 XGetWindowProperty (display, window, property,
385 offset/4, buffer_size/4,
386 (delete_p ? True : False),
388 actual_type_ret, actual_format_ret,
389 actual_size_ret, &bytes_remaining, &tmp_data);
391 stderr_out ("<< read %d\n", last-bytes_remaining);
393 /* If this doesn't return Success at this point, it means that
394 some clod deleted the selection while we were in the midst of
395 reading it. Deal with that, I guess....
397 if (result != Success) break;
398 *actual_size_ret *= *actual_format_ret / 8;
399 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
400 offset += *actual_size_ret;
401 XFree ((char *) tmp_data);
408 receive_incremental_selection (Display *display, Window window, Atom property,
409 /* this one is for error messages only */
410 Lisp_Object target_type,
411 unsigned int min_size_bytes,
412 Extbyte **data_ret, int *size_bytes_ret,
413 Atom *type_ret, int *format_ret,
414 unsigned long *size_ret)
416 /* This function can GC */
419 *size_bytes_ret = min_size_bytes;
420 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
422 stderr_out ("\nread INCR %d\n", min_size_bytes);
424 /* At this point, we have read an INCR property, and deleted it (which
425 is how we ack its receipt: the sending window will be selecting
426 PropertyNotify events on our window to notice this).
428 Now, we must loop, waiting for the sending window to put a value on
429 that property, then reading the property, then deleting it to ack.
430 We are done when the sender places a property of length 0.
432 prop_id = expect_property_change (display, window, property,
438 wait_for_property_change (prop_id);
439 /* expect it again immediately, because x_get_window_property may
440 .. no it won't, I don't get it.
441 .. Ok, I get it now, the Xt code that implements INCR is broken.
443 prop_id = expect_property_change (display, window, property,
445 x_get_window_property (display, window, property,
446 &tmp_data, &tmp_size_bytes,
447 type_ret, format_ret, size_ret, 1);
449 if (tmp_size_bytes == 0) /* we're done */
452 stderr_out (" read INCR done\n");
454 unexpect_property_change (prop_id);
455 if (tmp_data) xfree (tmp_data);
459 stderr_out (" read INCR %d\n", tmp_size_bytes);
461 if (*size_bytes_ret < offset + tmp_size_bytes)
464 stderr_out (" read INCR realloc %d -> %d\n",
465 *size_bytes_ret, offset + tmp_size_bytes);
467 *size_bytes_ret = offset + tmp_size_bytes;
468 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
470 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
471 offset += tmp_size_bytes;
478 gtk_get_window_property_as_lisp_data (struct device *d,
481 /* next two for error messages only */
482 Lisp_Object target_type,
483 GdkAtom selection_atom)
485 /* This function can GC */
488 unsigned long actual_size;
489 Extbyte *data = NULL;
492 struct device *d = get_device_from_display (display);
494 x_get_window_property (display, window, property, &data, &bytes,
495 &actual_type, &actual_format, &actual_size, 1);
498 if (XGetSelectionOwner (display, selection_atom))
499 /* there is a selection owner */
501 (Qselection_conversion_error,
502 Fcons (build_string ("selection owner couldn't convert"),
503 Fcons (x_atom_to_symbol (d, selection_atom),
505 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
506 list1 (target_type))));
508 signal_error (Qerror,
509 list2 (build_string ("no selection"),
510 x_atom_to_symbol (d, selection_atom)));
513 if (actual_type == DEVICE_XATOM_INCR (d))
515 /* Ok, that data wasn't *the* data, it was just the beginning. */
517 unsigned int min_size_bytes = * ((unsigned int *) data);
519 receive_incremental_selection (display, window, property, target_type,
520 min_size_bytes, &data, &bytes,
521 &actual_type, &actual_format,
525 /* It's been read. Now convert it to a lisp object in some semi-rational
527 val = selection_data_to_lisp_data (d, data, bytes,
528 actual_type, actual_format);
537 symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists)
539 if (NILP (sym)) return GDK_SELECTION_PRIMARY;
540 if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY;
541 if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY;
542 if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY;
546 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
547 return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE);
552 atom_to_symbol (struct device *d, GdkAtom atom)
554 if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY);
555 if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY);
559 char *str = gdk_atom_name (atom);
561 if (! str) return Qnil;
563 TO_INTERNAL_FORMAT (C_STRING, str,
564 C_STRING_ALLOCA, intstr,
567 return intern (intstr);
571 /* #### These are going to move into Lisp code(!) with the aid of
572 some new functions I'm working on - ajh */
574 /* These functions convert from the selection data read from the server into
575 something that we can use from elisp, and vice versa.
577 Type: Format: Size: Elisp Type:
578 ----- ------- ----- -----------
581 ATOM 32 > 1 Vector of Symbols
583 * 16 > 1 Vector of Integers
584 * 32 1 if <=16 bits: Integer
585 if > 16 bits: Cons of top16, bot16
586 * 32 > 1 Vector of the above
588 When converting a Lisp number to C, it is assumed to be of format 16 if
589 it is an integer, and of format 32 if it is a cons of two integers.
591 When converting a vector of numbers from Elisp to C, it is assumed to be
592 of format 16 if every element in the vector is an integer, and is assumed
593 to be of format 32 if any element is a cons of two integers.
595 When converting an object to C, it may be of the form (SYMBOL . <data>)
596 where SYMBOL is what we should claim that the type is. Format and
597 representation are as above.
599 NOTE: Under Mule, when someone shoves us a string without a type, we
600 set the type to 'COMPOUND_TEXT and automatically convert to Compound
601 Text. If the string has a type, we assume that the user wants the
602 data sent as-is so we just do "binary" conversion.
607 selection_data_to_lisp_data (struct device *d,
613 if (type == gdk_atom_intern ("NULL", 0))
616 /* Convert any 8-bit data to a string, for compactness. */
617 else if (format == 8)
618 return make_ext_string (data, size,
619 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
620 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
623 /* Convert a single atom to a Lisp Symbol.
624 Convert a set of atoms to a vector of symbols. */
625 else if (type == gdk_atom_intern ("ATOM", FALSE))
627 if (size == sizeof (GdkAtom))
628 return atom_to_symbol (d, *((GdkAtom *) data));
632 int len = size / sizeof (GdkAtom);
633 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
634 for (i = 0; i < len; i++)
635 Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i]));
640 /* Convert a single 16 or small 32 bit number to a Lisp Int.
641 If the number is > 16 bits, convert it to a cons of integers,
642 16 bits in each half.
644 else if (format == 32 && size == sizeof (long))
645 return word_to_lisp (((unsigned long *) data) [0]);
646 else if (format == 16 && size == sizeof (short))
647 return make_int ((int) (((unsigned short *) data) [0]));
649 /* Convert any other kind of data to a vector of numbers, represented
650 as above (as an integer, or a cons of two 16 bit integers).
652 #### Perhaps we should return the actual type to lisp as well.
654 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
657 and perhaps it should be
659 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
662 Right now the fact that the return type was SPAN is discarded before
663 lisp code gets to see it.
665 else if (format == 16)
668 Lisp_Object v = make_vector (size / 4, Qzero);
669 for (i = 0; i < (int) size / 4; i++)
671 int j = (int) ((unsigned short *) data) [i];
672 Faset (v, make_int (i), make_int (j));
679 Lisp_Object v = make_vector (size / 4, Qzero);
680 for (i = 0; i < (int) size / 4; i++)
682 unsigned long j = ((unsigned long *) data) [i];
683 Faset (v, make_int (i), word_to_lisp (j));
691 lisp_data_to_selection_data (struct device *d,
693 unsigned char **data_ret,
695 unsigned int *size_ret,
698 Lisp_Object type = Qnil;
700 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
704 if (CONSP (obj) && NILP (XCDR (obj)))
708 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
709 { /* This is not the same as declining */
715 else if (STRINGP (obj))
717 const Extbyte *extval;
720 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
721 ALLOCA, (extval, extvallen),
722 (NILP (type) ? Qctext : Qbinary));
724 *size_ret = extvallen;
725 *data_ret = (unsigned char *) xmalloc (*size_ret);
726 memcpy (*data_ret, extval, *size_ret);
728 if (NILP (type)) type = QCOMPOUND_TEXT;
730 if (NILP (type)) type = QSTRING;
733 else if (CHARP (obj))
735 Bufbyte buf[MAX_EMCHAR_LEN];
737 const Extbyte *extval;
741 len = set_charptr_emchar (buf, XCHAR (obj));
742 TO_EXTERNAL_FORMAT (DATA, (buf, len),
743 ALLOCA, (extval, extvallen),
745 *size_ret = extvallen;
746 *data_ret = (unsigned char *) xmalloc (*size_ret);
747 memcpy (*data_ret, extval, *size_ret);
749 if (NILP (type)) type = QCOMPOUND_TEXT;
751 if (NILP (type)) type = QSTRING;
754 else if (SYMBOLP (obj))
758 *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1);
759 (*data_ret) [sizeof (GdkAtom)] = 0;
760 (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0);
761 if (NILP (type)) type = QATOM;
763 else if (INTP (obj) &&
764 XINT (obj) <= 0x7FFF &&
765 XINT (obj) >= -0x8000)
769 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
770 (*data_ret) [sizeof (short)] = 0;
771 (*(short **) data_ret) [0] = (short) XINT (obj);
772 if (NILP (type)) type = QINTEGER;
774 else if (INTP (obj) || CONSP (obj))
778 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
779 (*data_ret) [sizeof (long)] = 0;
780 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
781 if (NILP (type)) type = QINTEGER;
783 else if (VECTORP (obj))
785 /* Lisp Vectors may represent a set of ATOMs;
786 a set of 16 or 32 bit INTEGERs;
787 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
791 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
792 /* This vector is an ATOM set */
794 if (NILP (type)) type = QATOM;
795 *size_ret = XVECTOR_LENGTH (obj);
797 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom));
798 for (i = 0; i < (int) (*size_ret); i++)
799 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
800 (*(GdkAtom **) data_ret) [i] =
801 symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0);
803 signal_error (Qerror, /* Qselection_error */
805 ("all elements of the vector must be of the same type"),
808 #if 0 /* #### MULTIPLE doesn't work yet */
809 else if (VECTORP (XVECTOR_DATA (obj) [0]))
810 /* This vector is an ATOM_PAIR set */
812 if (NILP (type)) type = QATOM_PAIR;
813 *size_ret = XVECTOR_LENGTH (obj);
815 *data_ret = (unsigned char *)
816 xmalloc ((*size_ret) * sizeof (Atom) * 2);
817 for (i = 0; i < *size_ret; i++)
818 if (VECTORP (XVECTOR_DATA (obj) [i]))
820 Lisp_Object pair = XVECTOR_DATA (obj) [i];
821 if (XVECTOR_LENGTH (pair) != 2)
822 signal_error (Qerror,
824 ("elements of the vector must be vectors of exactly two elements"),
827 (*(GdkAtom **) data_ret) [i * 2] =
828 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0);
829 (*(GdkAtom **) data_ret) [(i * 2) + 1] =
830 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0);
833 signal_error (Qerror,
835 ("all elements of the vector must be of the same type"),
840 /* This vector is an INTEGER set, or something like it */
842 *size_ret = XVECTOR_LENGTH (obj);
843 if (NILP (type)) type = QINTEGER;
845 for (i = 0; i < (int) (*size_ret); i++)
846 if (CONSP (XVECTOR_DATA (obj) [i]))
848 else if (!INTP (XVECTOR_DATA (obj) [i]))
849 signal_error (Qerror, /* Qselection_error */
851 ("all elements of the vector must be integers or conses of integers"),
854 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
855 for (i = 0; i < (int) (*size_ret); i++)
856 if (*format_ret == 32)
857 (*((unsigned long **) data_ret)) [i] =
858 lisp_to_word (XVECTOR_DATA (obj) [i]);
860 (*((unsigned short **) data_ret)) [i] =
861 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
865 signal_error (Qerror, /* Qselection_error */
866 list2 (build_string ("unrecognized selection data"),
869 *type_ret = symbol_to_gtk_atom (d, type, 0);
875 gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
876 Lisp_Object how_to_add, Lisp_Object selection_type)
878 struct device *d = decode_gtk_device (Qnil);
879 GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
880 Lisp_Object selection_time;
881 /* Use the time of the last-read mouse or keyboard event.
882 For selection purposes, we use this as a sleazy way of knowing what the
883 current time is in server-time. This assumes that the most recently read
884 mouse or keyboard event has something to do with the assertion of the
885 selection, which is probably true.
887 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d);
888 GdkAtom selection_atom;
890 CHECK_SYMBOL (selection_name);
891 selection_atom = symbol_to_gtk_atom (d, selection_name, 0);
893 gtk_selection_owner_set (selecting_window,
897 /* We do NOT use time_to_lisp() here any more, like we used to.
898 That assumed equivalence of time_t and Time, which is not
899 necessarily the case (e.g. under OSF on the Alphas, where
900 Time is a 64-bit quantity and time_t is a 32-bit quantity).
902 Opaque pointers are the clean way to go here.
904 selection_time = make_opaque (&thyme, sizeof (thyme));
906 return selection_time;
910 gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval)
912 struct device *d = decode_gtk_device (Qnil);
913 GdkAtom selection_atom;
916 CHECK_SYMBOL (selection);
917 selection_atom = symbol_to_gtk_atom (d, selection, 0);
920 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d);
924 lisp_to_time (timeval, &the_time);
925 timestamp = (guint32) the_time;
928 gtk_selection_owner_set (NULL, selection_atom, timestamp);
932 gtk_selection_exists_p (Lisp_Object selection,
933 Lisp_Object selection_type)
935 struct device *d = decode_gtk_device (Qnil);
937 return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil);
942 /************************************************************************/
944 /************************************************************************/
947 syms_of_select_gtk (void)
952 console_type_create_select_gtk (void)
954 CONSOLE_HAS_METHOD (gtk, own_selection);
955 CONSOLE_HAS_METHOD (gtk, disown_selection);
956 CONSOLE_HAS_METHOD (gtk, selection_exists_p);
957 CONSOLE_HAS_METHOD (gtk, get_foreign_selection);
961 vars_of_select_gtk (void)
963 staticpro (&Vretrieved_selection);
964 Vretrieved_selection = Qnil;
966 DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
967 A function or functions to be called after we have responded to some
968 other client's request for the value of a selection that we own. The
969 function(s) will be called with four arguments:
970 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
971 - the name of the selection-type which we were requested to convert the
972 selection into before sending (for example, STRING or LENGTH);
973 - and whether we successfully transmitted the selection.
974 We might have failed (and declined the request) for any number of reasons,
975 including being asked for a selection that we no longer own, or being asked
976 to convert into a type that we don't know about or that is inappropriate.
977 This hook doesn't let you change the behavior of emacs's selection replies,
978 it merely informs you that they have happened.
980 Vgtk_sent_selection_hooks = Qunbound;