Mercurial > hg > xemacs-beta
annotate src/select-gtk.c @ 5307:c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
src/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c:
* alloc.c (Fmake_list):
* alloc.c (Fmake_vector):
* alloc.c (Fmake_bit_vector):
* alloc.c (Fmake_byte_code):
* alloc.c (Fmake_string):
* alloc.c (vars_of_alloc):
* bytecode.c (UNUSED):
* bytecode.c (Fbyte_code):
* chartab.c (decode_char_table_range):
* cmds.c (Fself_insert_command):
* data.c (check_integer_range):
* data.c (Fnatnump):
* data.c (Fnonnegativep):
* data.c (Fstring_to_number):
* elhash.c (hash_table_size_validate):
* elhash.c (decode_hash_table_size):
* eval.c (Fbacktrace_frame):
* event-stream.c (lisp_number_to_milliseconds):
* event-stream.c (Faccept_process_output):
* event-stream.c (Frecent_keys):
* event-stream.c (Fdispatch_event):
* events.c (Fmake_event):
* events.c (Fevent_timestamp):
* events.c (Fevent_timestamp_lessp):
* events.h:
* events.h (struct command_builder):
* file-coding.c (gzip_putprop):
* fns.c:
* fns.c (check_sequence_range):
* fns.c (Frandom):
* fns.c (Fnthcdr):
* fns.c (Flast):
* fns.c (Fnbutlast):
* fns.c (Fbutlast):
* fns.c (Fmember):
* fns.c (Ffill):
* fns.c (Freduce):
* fns.c (replace_string_range_1):
* fns.c (Freplace):
* font-mgr.c (Ffc_pattern_get):
* frame-msw.c (msprinter_set_frame_properties):
* glyphs.c (check_valid_xbm_inline):
* indent.c (Fmove_to_column):
* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
* lisp.h:
* lisp.h (ARRAY_DIMENSION_LIMIT):
* lread.c (decode_mode_1):
* mule-ccl.c (ccl_get_compiled_code):
* number.h:
* process-unix.c (unix_open_multicast_group):
* process.c (Fset_process_window_size):
* profile.c (Fstart_profiling):
* unicode.c (Funicode_to_char):
Change NATNUMP to return 1 for positive bignums; changes uses of
it and of CHECK_NATNUM appropriately, usually by checking for an
integer in an appropriate range.
Add array-dimension-limit and use it in #'make-vector,
#'make-string. Add array-total-size-limit, array-rank-limit while
we're at it, for the sake of any Common Lisp-oriented code that
uses these limits.
Rename check_int_range to check_integer_range, have it take
Lisp_Objects (and thus bignums) instead.
Remove bignum_butlast(), just set int_n to an appropriately large
integer if N is a bignum.
Accept bignums in check_sequence_range(), change the functions
that use check_sequence_range() appropriately.
Move the definition of NATNUMP() to number.h; document why it's a
reasonable name, contradicting an old comment.
tests/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (wrong-type-argument):
* automated/mule-tests.el (featurep):
Check for args-out-of-range errors instead of wrong-type-argument
errors in various places when code is handed a large bignum
instead of a fixnum.
Also check for the wrong-type-argument errors when giving the same
code a non-integer value.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 20 Nov 2010 16:49:11 +0000 |
| parents | 358aa3bb603f |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 462 | 1 /* GTK selection processing for XEmacs |
| 2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 771 | 3 Copyright (C) 2001 Ben Wing. |
| 462 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not synched with FSF. */ | |
| 23 | |
| 24 /* Authorship: | |
| 25 | |
| 26 Written by Kevin Gallo for FSF Emacs. | |
| 27 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. | |
| 28 Rewritten for GTK by William Perry, April 2000 for 21.1 | |
| 29 */ | |
| 30 | |
| 31 | |
| 32 #include <config.h> | |
| 33 #include "lisp.h" | |
| 872 | 34 |
| 462 | 35 #include "buffer.h" |
| 872 | 36 #include "device-impl.h" |
| 37 #include "events.h" | |
| 38 #include "frame.h" | |
| 39 #include "opaque.h" | |
| 462 | 40 #include "select.h" |
| 872 | 41 |
| 42 #include "console-gtk-impl.h" | |
| 462 | 43 |
| 44 static Lisp_Object Vretrieved_selection; | |
| 45 static gboolean waiting_for_selection; | |
| 46 Lisp_Object Vgtk_sent_selection_hooks; | |
| 47 | |
| 778 | 48 extern int lisp_to_time (Lisp_Object, time_t *); |
| 49 extern Lisp_Object time_to_lisp (time_t); | |
| 50 | |
| 647 | 51 static GdkAtom |
| 2286 | 52 symbol_to_gtk_atom (struct device *UNUSED (d), Lisp_Object sym, |
| 53 int only_if_exists) | |
| 647 | 54 { |
| 55 if (NILP (sym)) return GDK_SELECTION_PRIMARY; | |
| 56 if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY; | |
| 57 if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY; | |
| 58 if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY; | |
| 59 | |
| 60 { | |
| 61 const Extbyte *nameext; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
62 nameext = LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), Qctext); |
| 647 | 63 return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE); |
| 64 } | |
| 65 } | |
| 462 | 66 |
| 647 | 67 static Lisp_Object |
| 2286 | 68 atom_to_symbol (struct device *UNUSED (d), GdkAtom atom) |
| 647 | 69 { |
| 70 if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY); | |
| 71 if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY); | |
| 72 | |
| 73 { | |
| 867 | 74 Ibyte *intstr; |
| 647 | 75 Extbyte *str = gdk_atom_name (atom); |
| 76 | |
| 77 if (! str) return Qnil; | |
| 462 | 78 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
79 intstr = EXTERNAL_TO_ITEXT (str, Qctext); |
| 647 | 80 g_free (str); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2620
diff
changeset
|
81 return intern_istring (intstr); |
| 647 | 82 } |
| 83 } | |
| 84 | |
| 4984 | 85 #define THIS_IS_GTK |
| 86 #include "select-xlike-inc.c" | |
| 87 #undef THIS_IS_GTK | |
| 647 | 88 |
| 89 | |
| 462 | 90 /* Set the selection data to GDK_NONE and NULL data, meaning we were |
| 91 ** unable to do what they wanted. | |
| 92 */ | |
| 93 static void | |
| 94 gtk_decline_selection_request (GtkSelectionData *data) | |
| 95 { | |
| 96 gtk_selection_data_set (data, GDK_NONE, 0, NULL, 0); | |
| 97 } | |
| 98 | |
| 99 /* Used as an unwind-protect clause so that, if a selection-converter signals | |
| 100 an error, we tell the requestor that we were unable to do what they wanted | |
| 101 before we throw to top-level or go into the debugger or whatever. | |
| 102 */ | |
| 103 struct _selection_closure | |
| 104 { | |
| 105 GtkSelectionData *data; | |
| 106 gboolean successful; | |
| 107 }; | |
| 108 | |
| 109 static Lisp_Object | |
| 110 gtk_selection_request_lisp_error (Lisp_Object closure) | |
| 111 { | |
| 112 struct _selection_closure *cl = (struct _selection_closure *) | |
| 113 get_opaque_ptr (closure); | |
| 114 | |
| 115 free_opaque_ptr (closure); | |
| 116 if (cl->successful == TRUE) | |
| 117 return Qnil; | |
| 118 gtk_decline_selection_request (cl->data); | |
| 119 return Qnil; | |
| 120 } | |
| 121 | |
| 122 /* This provides the current selection to a requester. | |
| 123 ** | |
| 124 ** This is connected to the selection_get() signal of the application | |
| 125 ** shell in device-gtk.c:gtk_init_device(). | |
| 126 ** | |
| 127 ** This is radically different than the old selection code (21.1.x), | |
| 128 ** but has been modeled after the X code, and appears to work. | |
| 129 ** | |
| 130 ** WMP Feb 12 2001 | |
| 131 */ | |
| 132 void | |
| 2286 | 133 emacs_gtk_selection_handle (GtkWidget *UNUSED (widget), |
| 462 | 134 GtkSelectionData *selection_data, |
| 2286 | 135 guint UNUSED (info), |
| 462 | 136 guint time_stamp, |
| 2286 | 137 gpointer UNUSED (data)) |
| 462 | 138 { |
| 139 /* This function can GC */ | |
| 140 struct gcpro gcpro1, gcpro2; | |
| 141 Lisp_Object temp_obj; | |
| 142 Lisp_Object selection_symbol; | |
| 143 Lisp_Object target_symbol = Qnil; | |
| 144 Lisp_Object converted_selection = Qnil; | |
| 145 guint32 local_selection_time; | |
| 146 Lisp_Object successful_p = Qnil; | |
| 147 int count; | |
| 148 struct device *d = decode_gtk_device (Qnil); | |
| 149 struct _selection_closure *cl = NULL; | |
| 150 | |
| 151 GCPRO2 (converted_selection, target_symbol); | |
| 152 | |
| 153 selection_symbol = atom_to_symbol (d, selection_data->selection); | |
| 154 target_symbol = atom_to_symbol (d, selection_data->target); | |
| 155 | |
| 156 #if 0 /* #### MULTIPLE doesn't work yet */ | |
| 157 if (EQ (target_symbol, QMULTIPLE)) | |
| 158 target_symbol = fetch_multiple_target (selection_data); | |
| 159 #endif | |
| 160 | |
| 2620 | 161 temp_obj = get_selection_raw_time(selection_symbol); |
| 462 | 162 |
| 163 if (NILP (temp_obj)) | |
| 164 { | |
| 165 /* We don't appear to have the selection. */ | |
| 166 gtk_decline_selection_request (selection_data); | |
| 167 | |
| 168 goto DONE_LABEL; | |
| 169 } | |
| 170 | |
| 171 local_selection_time = * (guint32 *) XOPAQUE_DATA (temp_obj); | |
| 172 | |
| 173 if (time_stamp != GDK_CURRENT_TIME && | |
| 174 local_selection_time > time_stamp) | |
| 175 { | |
| 176 /* Someone asked for the selection, and we have one, but not the one | |
| 177 they're looking for. */ | |
| 178 gtk_decline_selection_request (selection_data); | |
| 179 goto DONE_LABEL; | |
| 180 } | |
| 181 | |
| 182 converted_selection = select_convert_out (selection_symbol, | |
| 183 target_symbol, Qnil); | |
| 184 | |
| 185 /* #### Is this the right thing to do? I'm no X expert. -- ajh */ | |
| 186 if (NILP (converted_selection)) | |
| 187 { | |
| 188 /* We don't appear to have a selection in that data type. */ | |
| 189 gtk_decline_selection_request (selection_data); | |
| 190 goto DONE_LABEL; | |
| 191 } | |
| 192 | |
| 193 count = specpdl_depth (); | |
| 194 | |
| 2367 | 195 cl = xnew (struct _selection_closure); |
| 462 | 196 cl->data = selection_data; |
| 197 cl->successful = FALSE; | |
| 198 | |
| 199 record_unwind_protect (gtk_selection_request_lisp_error, | |
| 200 make_opaque_ptr (cl)); | |
| 201 | |
| 202 { | |
| 2367 | 203 Rawbyte *data; |
| 665 | 204 Bytecount size; |
| 462 | 205 int format; |
| 206 GdkAtom type; | |
| 207 lisp_data_to_selection_data (d, converted_selection, | |
| 208 &data, &type, &size, &format); | |
| 209 | |
| 647 | 210 gtk_selection_data_set (selection_data, type, format, data, |
| 211 /* #### is this right? */ | |
| 212 (unsigned int) size); | |
| 462 | 213 successful_p = Qt; |
| 214 /* Tell x_selection_request_lisp_error() it's cool. */ | |
| 215 cl->successful = TRUE; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
216 xfree (data); |
| 462 | 217 } |
| 218 | |
| 771 | 219 unbind_to (count); |
| 462 | 220 |
| 221 DONE_LABEL: | |
| 222 | |
| 1726 | 223 if (cl) |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
224 xfree (cl); |
| 462 | 225 |
| 226 UNGCPRO; | |
| 227 | |
| 228 /* Let random lisp code notice that the selection has been asked for. */ | |
| 229 { | |
| 230 Lisp_Object val = Vgtk_sent_selection_hooks; | |
| 231 if (!UNBOUNDP (val) && !NILP (val)) | |
| 232 { | |
| 233 Lisp_Object rest; | |
| 234 if (CONSP (val) && !EQ (XCAR (val), Qlambda)) | |
| 235 for (rest = val; !NILP (rest); rest = Fcdr (rest)) | |
| 236 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); | |
| 237 else | |
| 238 call3 (val, selection_symbol, target_symbol, successful_p); | |
| 239 } | |
| 240 } | |
| 241 } | |
| 242 | |
| 243 | |
| 746 | 244 void |
| 2286 | 245 emacs_gtk_selection_clear_event_handle (GtkWidget *UNUSED (widget), |
| 746 | 246 GdkEventSelection *event, |
| 2286 | 247 gpointer UNUSED (data)) |
| 746 | 248 { |
| 249 GdkAtom selection = event->selection; | |
| 250 guint32 changed_owner_time = event->time; | |
| 251 struct device *d = decode_gtk_device (Qnil); | |
| 252 | |
| 253 Lisp_Object selection_symbol, local_selection_time_lisp; | |
| 254 guint32 local_selection_time; | |
| 255 | |
| 256 selection_symbol = atom_to_symbol (d, selection); | |
| 257 | |
| 2620 | 258 local_selection_time_lisp = get_selection_raw_time (selection_symbol); |
| 746 | 259 |
| 260 /* We don't own the selection, so that's fine. */ | |
| 261 if (NILP (local_selection_time_lisp)) | |
| 262 return; | |
| 263 | |
| 264 local_selection_time = *(guint32 *) XOPAQUE_DATA (local_selection_time_lisp); | |
| 265 | |
| 266 /* This SelectionClear is for a selection that we no longer own, so we can | |
| 267 disregard it. (That is, we have reasserted the selection since this | |
| 268 request was generated.) | |
| 269 */ | |
| 270 if (changed_owner_time != GDK_CURRENT_TIME && | |
| 271 local_selection_time > changed_owner_time) | |
| 272 return; | |
| 273 | |
| 274 handle_selection_clear (selection_symbol); | |
| 275 } | |
| 276 | |
| 277 | |
| 462 | 278 |
| 279 static GtkWidget *reading_selection_reply; | |
| 280 static GdkAtom reading_which_selection; | |
| 281 static int selection_reply_timed_out; | |
| 282 | |
| 283 /* Gets the current selection owned by another application */ | |
| 284 void | |
| 2286 | 285 emacs_gtk_selection_received (GtkWidget *UNUSED (widget), |
| 462 | 286 GtkSelectionData *selection_data, |
| 2286 | 287 gpointer UNUSED (user_data)) |
| 462 | 288 { |
| 289 waiting_for_selection = FALSE; | |
| 290 Vretrieved_selection = Qnil; | |
| 291 | |
| 292 reading_selection_reply = NULL; | |
| 293 | |
| 294 signal_fake_event (); | |
| 295 | |
| 296 if (selection_data->length < 0) | |
| 297 { | |
| 298 return; | |
| 299 } | |
| 300 | |
| 301 Vretrieved_selection = | |
| 302 selection_data_to_lisp_data (NULL, | |
| 303 selection_data->data, | |
| 304 selection_data->length, | |
| 305 selection_data->type, | |
| 306 selection_data->format); | |
| 307 } | |
| 308 | |
| 309 static int | |
| 2286 | 310 selection_reply_done (void *UNUSED (ignore)) |
| 462 | 311 { |
| 312 return !reading_selection_reply; | |
| 313 } | |
| 314 | |
| 315 /* Do protocol to read selection-data from the server. | |
| 316 Converts this to lisp data and returns it. | |
| 317 */ | |
| 318 static Lisp_Object | |
| 319 gtk_get_foreign_selection (Lisp_Object selection_symbol, | |
| 320 Lisp_Object target_type) | |
| 321 { | |
| 322 /* This function can GC */ | |
| 323 struct device *d = decode_gtk_device (Qnil); | |
| 324 GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d); | |
| 325 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d); | |
| 326 GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0); | |
| 327 int speccount; | |
| 328 GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ? | |
| 329 XCAR (target_type) : target_type), 0); | |
| 330 | |
| 331 gtk_selection_convert (requestor, selection_atom, type_atom, | |
| 332 requestor_time); | |
| 333 | |
| 334 signal_fake_event (); | |
| 335 | |
| 336 /* Block until the reply has been read. */ | |
| 337 reading_selection_reply = requestor; | |
| 338 reading_which_selection = selection_atom; | |
| 339 selection_reply_timed_out = 0; | |
| 340 | |
| 341 speccount = specpdl_depth (); | |
| 342 | |
| 343 #if 0 | |
| 344 /* add a timeout handler */ | |
| 345 if (gtk_selection_timeout > 0) | |
| 346 { | |
| 347 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout), | |
| 348 Qx_selection_reply_timeout_internal, | |
| 349 Qnil, Qnil); | |
| 350 record_unwind_protect (Fdisable_timeout, id); | |
| 351 } | |
| 352 #endif | |
| 353 | |
| 354 /* This is ^Gable */ | |
| 355 wait_delaying_user_input (selection_reply_done, 0); | |
| 356 | |
| 357 if (selection_reply_timed_out) | |
| 563 | 358 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound); |
| 462 | 359 |
| 771 | 360 unbind_to (speccount); |
| 462 | 361 |
| 362 /* otherwise, the selection is waiting for us on the requested property. */ | |
| 363 return select_convert_in (selection_symbol, | |
| 364 target_type, | |
| 365 Vretrieved_selection); | |
| 366 } | |
| 367 | |
| 368 | |
| 369 #if 0 | |
| 370 static void | |
| 371 gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property, | |
| 372 Extbyte **data_ret, int *bytes_ret, | |
| 373 GdkAtom *actual_type_ret, int *actual_format_ret, | |
| 374 unsigned long *actual_size_ret, int delete_p) | |
| 375 { | |
| 647 | 376 /* deleted */ |
| 462 | 377 } |
| 378 | |
| 379 | |
| 380 static void | |
| 381 receive_incremental_selection (Display *display, Window window, Atom property, | |
| 382 /* this one is for error messages only */ | |
| 383 Lisp_Object target_type, | |
| 384 unsigned int min_size_bytes, | |
| 385 Extbyte **data_ret, int *size_bytes_ret, | |
| 386 Atom *type_ret, int *format_ret, | |
| 387 unsigned long *size_ret) | |
| 388 { | |
| 647 | 389 /* deleted */ |
| 462 | 390 } |
| 391 | |
| 392 | |
| 393 static Lisp_Object | |
| 394 gtk_get_window_property_as_lisp_data (struct device *d, | |
| 395 GtkWidget *window, | |
| 396 GdkAtom property, | |
| 397 /* next two for error messages only */ | |
| 398 Lisp_Object target_type, | |
| 399 GdkAtom selection_atom) | |
| 400 { | |
| 647 | 401 /* deleted */ |
| 462 | 402 } |
| 403 #endif | |
| 404 | |
| 405 | |
| 406 | |
| 407 static Lisp_Object | |
| 2286 | 408 gtk_own_selection (Lisp_Object selection_name, |
| 409 Lisp_Object UNUSED (selection_value), | |
| 410 Lisp_Object UNUSED (how_to_add), | |
| 411 Lisp_Object UNUSED (selection_type), int UNUSED (owned_p)) | |
| 462 | 412 { |
| 413 struct device *d = decode_gtk_device (Qnil); | |
| 414 GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d)); | |
| 415 /* Use the time of the last-read mouse or keyboard event. | |
| 416 For selection purposes, we use this as a sleazy way of knowing what the | |
| 417 current time is in server-time. This assumes that the most recently read | |
| 418 mouse or keyboard event has something to do with the assertion of the | |
| 419 selection, which is probably true. | |
| 420 */ | |
| 421 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d); | |
| 422 GdkAtom selection_atom; | |
| 423 | |
| 424 CHECK_SYMBOL (selection_name); | |
| 425 selection_atom = symbol_to_gtk_atom (d, selection_name, 0); | |
| 426 | |
| 427 gtk_selection_owner_set (selecting_window, | |
| 428 selection_atom, | |
| 429 thyme); | |
| 430 | |
| 2620 | 431 /* [[ We do NOT use time_to_lisp() here any more, like we used to. |
| 462 | 432 That assumed equivalence of time_t and Time, which is not |
| 433 necessarily the case (e.g. under OSF on the Alphas, where | |
| 434 Time is a 64-bit quantity and time_t is a 32-bit quantity). | |
| 435 | |
| 2620 | 436 Opaque pointers are the clean way to go here. ]] |
| 437 | |
| 438 See my comment on the same issue in select-x.c -- Aidan. */ | |
| 793 | 439 return make_opaque (&thyme, sizeof (thyme)); |
| 462 | 440 } |
| 441 | |
| 442 static void | |
| 443 gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval) | |
| 444 { | |
| 445 struct device *d = decode_gtk_device (Qnil); | |
| 446 GdkAtom selection_atom; | |
| 447 guint32 timestamp; | |
| 448 | |
| 449 CHECK_SYMBOL (selection); | |
| 450 selection_atom = symbol_to_gtk_atom (d, selection, 0); | |
| 451 | |
| 452 if (NILP (timeval)) | |
| 453 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d); | |
| 454 else | |
| 455 { | |
| 456 time_t the_time; | |
| 457 lisp_to_time (timeval, &the_time); | |
| 458 timestamp = (guint32) the_time; | |
| 459 } | |
| 460 | |
| 461 gtk_selection_owner_set (NULL, selection_atom, timestamp); | |
| 462 } | |
| 463 | |
| 464 static Lisp_Object | |
| 465 gtk_selection_exists_p (Lisp_Object selection, | |
| 2286 | 466 Lisp_Object UNUSED (selection_type)) |
| 462 | 467 { |
| 468 struct device *d = decode_gtk_device (Qnil); | |
| 469 | |
| 470 return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil); | |
| 471 } | |
| 472 | |
| 473 | |
| 474 | |
| 475 /************************************************************************/ | |
| 476 /* initialization */ | |
| 477 /************************************************************************/ | |
| 478 | |
| 479 void | |
| 480 syms_of_select_gtk (void) | |
| 481 { | |
| 482 } | |
| 483 | |
| 484 void | |
| 485 console_type_create_select_gtk (void) | |
| 486 { | |
| 487 CONSOLE_HAS_METHOD (gtk, own_selection); | |
| 488 CONSOLE_HAS_METHOD (gtk, disown_selection); | |
| 489 CONSOLE_HAS_METHOD (gtk, selection_exists_p); | |
| 490 CONSOLE_HAS_METHOD (gtk, get_foreign_selection); | |
| 491 } | |
| 492 | |
| 493 void | |
| 494 vars_of_select_gtk (void) | |
| 495 { | |
| 496 staticpro (&Vretrieved_selection); | |
| 497 Vretrieved_selection = Qnil; | |
| 498 | |
| 499 DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /* | |
| 500 A function or functions to be called after we have responded to some | |
| 501 other client's request for the value of a selection that we own. The | |
| 502 function(s) will be called with four arguments: | |
| 503 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); | |
| 504 - the name of the selection-type which we were requested to convert the | |
| 505 selection into before sending (for example, STRING or LENGTH); | |
| 506 - and whether we successfully transmitted the selection. | |
| 507 We might have failed (and declined the request) for any number of reasons, | |
| 508 including being asked for a selection that we no longer own, or being asked | |
| 509 to convert into a type that we don't know about or that is inappropriate. | |
| 510 This hook doesn't let you change the behavior of emacs's selection replies, | |
| 511 it merely informs you that they have happened. | |
| 512 */ ); | |
| 513 Vgtk_sent_selection_hooks = Qunbound; | |
| 514 } |