Mercurial > hg > xemacs-beta
diff src/select-gtk.c @ 647:b39c14581166
[xemacs-hg @ 2001-08-13 04:45:47 by ben]
removal of unsigned, size_t, etc.
author | ben |
---|---|
date | Mon, 13 Aug 2001 04:46:48 +0000 |
parents | 183866b06e0b |
children | fdefd0186b75 |
line wrap: on
line diff
--- a/src/select-gtk.c Wed Aug 08 12:15:04 2001 +0000 +++ b/src/select-gtk.c Mon Aug 13 04:46:48 2001 +0000 @@ -42,21 +42,46 @@ static gboolean waiting_for_selection; Lisp_Object Vgtk_sent_selection_hooks; -static Lisp_Object atom_to_symbol (struct device *d, GdkAtom atom); -static GdkAtom symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists); +static GdkAtom +symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists) +{ + if (NILP (sym)) return GDK_SELECTION_PRIMARY; + if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY; + if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY; + if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY; + + { + const Extbyte *nameext; + LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext); + return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE); + } +} -static void lisp_data_to_selection_data (struct device *, - Lisp_Object obj, - unsigned char **data_ret, - GdkAtom *type_ret, - unsigned int *size_ret, - int *format_ret); -static Lisp_Object selection_data_to_lisp_data (struct device *, - Extbyte *data, - size_t size, - GdkAtom type, - int format); +static Lisp_Object +atom_to_symbol (struct device *d, GdkAtom atom) +{ + if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY); + if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY); + + { + CBufbyte *intstr; + Extbyte *str = gdk_atom_name (atom); + + if (! str) return Qnil; + TO_INTERNAL_FORMAT (C_STRING, str, + C_STRING_ALLOCA, intstr, + Qctext); + g_free (str); + return intern (intstr); + } +} + +#define PROCESSING_GTK_CODE +#include "select-common.h" +#undef PROCESSING_GTK_CODE + + /* Set the selection data to GDK_NONE and NULL data, meaning we were ** unable to do what they wanted. */ @@ -170,14 +195,16 @@ make_opaque_ptr (cl)); { - unsigned char *data; - unsigned int size; + UChar_Binary *data; + Memory_Count size; int format; GdkAtom type; lisp_data_to_selection_data (d, converted_selection, &data, &type, &size, &format); - gtk_selection_data_set (selection_data, type, format, data, size); + gtk_selection_data_set (selection_data, type, format, data, + /* #### is this right? */ + (unsigned int) size); successful_p = Qt; /* Tell x_selection_request_lisp_error() it's cool. */ cl->successful = TRUE; @@ -306,66 +333,7 @@ GdkAtom *actual_type_ret, int *actual_format_ret, unsigned long *actual_size_ret, int delete_p) { - size_t total_size; - unsigned long bytes_remaining; - int offset = 0; - unsigned char *tmp_data = 0; - int result; - int buffer_size = SELECTION_QUANTUM (display); - if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; - - /* First probe the thing to find out how big it is. */ - result = XGetWindowProperty (display, window, property, - 0, 0, False, AnyPropertyType, - actual_type_ret, actual_format_ret, - actual_size_ret, - &bytes_remaining, &tmp_data); - if (result != Success) - { - *data_ret = 0; - *bytes_ret = 0; - return; - } - XFree ((char *) tmp_data); - - if (*actual_type_ret == None || *actual_format_ret == 0) - { - if (delete_p) XDeleteProperty (display, window, property); - *data_ret = 0; - *bytes_ret = 0; - return; - } - - total_size = bytes_remaining + 1; - *data_ret = (Extbyte *) xmalloc (total_size); - - /* Now read, until we've gotten it all. */ - while (bytes_remaining) - { -#if 0 - int last = bytes_remaining; -#endif - result = - XGetWindowProperty (display, window, property, - offset/4, buffer_size/4, - (delete_p ? True : False), - AnyPropertyType, - actual_type_ret, actual_format_ret, - actual_size_ret, &bytes_remaining, &tmp_data); -#if 0 - stderr_out ("<< read %d\n", last-bytes_remaining); -#endif - /* If this doesn't return Success at this point, it means that - some clod deleted the selection while we were in the midst of - reading it. Deal with that, I guess.... - */ - if (result != Success) break; - *actual_size_ret *= *actual_format_ret / 8; - memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); - offset += *actual_size_ret; - XFree ((char *) tmp_data); - } - *bytes_ret = offset; + /* deleted */ } @@ -378,64 +346,7 @@ Atom *type_ret, int *format_ret, unsigned long *size_ret) { - /* This function can GC */ - int offset = 0; - int prop_id; - *size_bytes_ret = min_size_bytes; - *data_ret = (Extbyte *) xmalloc (*size_bytes_ret); -#if 0 - stderr_out ("\nread INCR %d\n", min_size_bytes); -#endif - /* At this point, we have read an INCR property, and deleted it (which - is how we ack its receipt: the sending window will be selecting - PropertyNotify events on our window to notice this). - - Now, we must loop, waiting for the sending window to put a value on - that property, then reading the property, then deleting it to ack. - We are done when the sender places a property of length 0. - */ - prop_id = expect_property_change (display, window, property, - PropertyNewValue); - while (1) - { - Extbyte *tmp_data; - int tmp_size_bytes; - wait_for_property_change (prop_id); - /* expect it again immediately, because x_get_window_property may - .. no it won't, I don't get it. - .. Ok, I get it now, the Xt code that implements INCR is broken. - */ - prop_id = expect_property_change (display, window, property, - PropertyNewValue); - x_get_window_property (display, window, property, - &tmp_data, &tmp_size_bytes, - type_ret, format_ret, size_ret, 1); - - if (tmp_size_bytes == 0) /* we're done */ - { -#if 0 - stderr_out (" read INCR done\n"); -#endif - unexpect_property_change (prop_id); - if (tmp_data) xfree (tmp_data); - break; - } -#if 0 - stderr_out (" read INCR %d\n", tmp_size_bytes); -#endif - if (*size_bytes_ret < offset + tmp_size_bytes) - { -#if 0 - stderr_out (" read INCR realloc %d -> %d\n", - *size_bytes_ret, offset + tmp_size_bytes); -#endif - *size_bytes_ret = offset + tmp_size_bytes; - *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret); - } - memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); - offset += tmp_size_bytes; - xfree (tmp_data); - } + /* deleted */ } @@ -447,385 +358,11 @@ Lisp_Object target_type, GdkAtom selection_atom) { - /* This function can GC */ - Atom actual_type; - int actual_format; - unsigned long actual_size; - Extbyte *data = NULL; - int bytes = 0; - Lisp_Object val; - struct device *d = get_device_from_display (display); - - x_get_window_property (display, window, property, &data, &bytes, - &actual_type, &actual_format, &actual_size, 1); - if (! data) - { - if (XGetSelectionOwner (display, selection_atom)) - /* there is a selection owner */ - signal_error (Qselection_conversion_error, - "selection owner couldn't convert", - Fcons (Qunbound, - Fcons (x_atom_to_symbol (d, selection_atom), - actual_type ? - list2 (target_type, - x_atom_to_symbol (d, actual_type)) : - list1 (target_type)))); - else - signal_error (Qselection_conversion_error, - "no selection", - x_atom_to_symbol (d, selection_atom)); - } - - if (actual_type == DEVICE_XATOM_INCR (d)) - { - /* Ok, that data wasn't *the* data, it was just the beginning. */ - - unsigned int min_size_bytes = * ((unsigned int *) data); - xfree (data); - receive_incremental_selection (display, window, property, target_type, - min_size_bytes, &data, &bytes, - &actual_type, &actual_format, - &actual_size); - } - - /* It's been read. Now convert it to a lisp object in some semi-rational - manner. */ - val = selection_data_to_lisp_data (d, data, bytes, - actual_type, actual_format); - - xfree (data); - return val; + /* deleted */ } #endif -static GdkAtom -symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists) -{ - if (NILP (sym)) return GDK_SELECTION_PRIMARY; - if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY; - if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY; - if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY; - - { - const char *nameext; - LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext); - return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE); - } -} - -static Lisp_Object -atom_to_symbol (struct device *d, GdkAtom atom) -{ - if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY); - if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY); - - { - char *intstr; - char *str = gdk_atom_name (atom); - - if (! str) return Qnil; - - TO_INTERNAL_FORMAT (C_STRING, str, - C_STRING_ALLOCA, intstr, - Qctext); - g_free (str); - return intern (intstr); - } -} - -/* #### These are going to move into Lisp code(!) with the aid of - some new functions I'm working on - ajh */ - -/* These functions convert from the selection data read from the server into - something that we can use from elisp, and vice versa. - - Type: Format: Size: Elisp Type: - ----- ------- ----- ----------- - * 8 * String - ATOM 32 1 Symbol - ATOM 32 > 1 Vector of Symbols - * 16 1 Integer - * 16 > 1 Vector of Integers - * 32 1 if <=16 bits: Integer - if > 16 bits: Cons of top16, bot16 - * 32 > 1 Vector of the above - - When converting a Lisp number to C, it is assumed to be of format 16 if - it is an integer, and of format 32 if it is a cons of two integers. - - When converting a vector of numbers from Elisp to C, it is assumed to be - of format 16 if every element in the vector is an integer, and is assumed - to be of format 32 if any element is a cons of two integers. - - When converting an object to C, it may be of the form (SYMBOL . <data>) - where SYMBOL is what we should claim that the type is. Format and - representation are as above. - - NOTE: Under Mule, when someone shoves us a string without a type, we - set the type to 'COMPOUND_TEXT and automatically convert to Compound - Text. If the string has a type, we assume that the user wants the - data sent as-is so we just do "binary" conversion. - */ - - -static Lisp_Object -selection_data_to_lisp_data (struct device *d, - Extbyte *data, - size_t size, - GdkAtom type, - int format) -{ - if (type == gdk_atom_intern ("NULL", 0)) - return QNULL; - - /* Convert any 8-bit data to a string, for compactness. */ - else if (format == 8) - return make_ext_string (data, size, - ((type == gdk_atom_intern ("TEXT", FALSE)) || - (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE))) - ? Qctext : Qbinary); - - /* Convert a single atom to a Lisp Symbol. - Convert a set of atoms to a vector of symbols. */ - else if (type == gdk_atom_intern ("ATOM", FALSE)) - { - if (size == sizeof (GdkAtom)) - return atom_to_symbol (d, *((GdkAtom *) data)); - else - { - int i; - int len = size / sizeof (GdkAtom); - Lisp_Object v = Fmake_vector (make_int (len), Qzero); - for (i = 0; i < len; i++) - Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i])); - return v; - } - } - - /* Convert a single 16 or small 32 bit number to a Lisp Int. - If the number is > 16 bits, convert it to a cons of integers, - 16 bits in each half. - */ - else if (format == 32 && size == sizeof (long)) - return word_to_lisp (((unsigned long *) data) [0]); - else if (format == 16 && size == sizeof (short)) - return make_int ((int) (((unsigned short *) data) [0])); - - /* Convert any other kind of data to a vector of numbers, represented - as above (as an integer, or a cons of two 16 bit integers). - - #### Perhaps we should return the actual type to lisp as well. - - (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) - ==> [4 4] - - and perhaps it should be - - (x-get-selection-internal 'PRIMARY 'LINE_NUMBER) - ==> (SPAN . [4 4]) - - Right now the fact that the return type was SPAN is discarded before - lisp code gets to see it. - */ - else if (format == 16) - { - int i; - Lisp_Object v = make_vector (size / 4, Qzero); - for (i = 0; i < (int) size / 4; i++) - { - int j = (int) ((unsigned short *) data) [i]; - Faset (v, make_int (i), make_int (j)); - } - return v; - } - else - { - int i; - Lisp_Object v = make_vector (size / 4, Qzero); - for (i = 0; i < (int) size / 4; i++) - { - unsigned long j = ((unsigned long *) data) [i]; - Faset (v, make_int (i), word_to_lisp (j)); - } - return v; - } -} - - -static void -lisp_data_to_selection_data (struct device *d, - Lisp_Object obj, - unsigned char **data_ret, - GdkAtom *type_ret, - unsigned int *size_ret, - int *format_ret) -{ - Lisp_Object type = Qnil; - - if (CONSP (obj) && SYMBOLP (XCAR (obj))) - { - type = XCAR (obj); - obj = XCDR (obj); - if (CONSP (obj) && NILP (XCDR (obj))) - obj = XCAR (obj); - } - - if (EQ (obj, QNULL) || (EQ (type, QNULL))) - { /* This is not the same as declining */ - *format_ret = 32; - *size_ret = 0; - *data_ret = 0; - type = QNULL; - } - else if (STRINGP (obj)) - { - const Extbyte *extval; - Extcount extvallen; - - TO_EXTERNAL_FORMAT (LISP_STRING, obj, - ALLOCA, (extval, extvallen), - (NILP (type) ? Qctext : Qbinary)); - *format_ret = 8; - *size_ret = extvallen; - *data_ret = (unsigned char *) xmalloc (*size_ret); - memcpy (*data_ret, extval, *size_ret); -#ifdef MULE - if (NILP (type)) type = QCOMPOUND_TEXT; -#else - if (NILP (type)) type = QSTRING; -#endif - } - else if (CHARP (obj)) - { - Bufbyte buf[MAX_EMCHAR_LEN]; - Bytecount len; - const Extbyte *extval; - Extcount extvallen; - - *format_ret = 8; - len = set_charptr_emchar (buf, XCHAR (obj)); - TO_EXTERNAL_FORMAT (DATA, (buf, len), - ALLOCA, (extval, extvallen), - Qctext); - *size_ret = extvallen; - *data_ret = (unsigned char *) xmalloc (*size_ret); - memcpy (*data_ret, extval, *size_ret); -#ifdef MULE - if (NILP (type)) type = QCOMPOUND_TEXT; -#else - if (NILP (type)) type = QSTRING; -#endif - } - else if (SYMBOLP (obj)) - { - *format_ret = 32; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1); - (*data_ret) [sizeof (GdkAtom)] = 0; - (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0); - if (NILP (type)) type = QATOM; - } - else if (INTP (obj) && - XINT (obj) <= 0x7FFF && - XINT (obj) >= -0x8000) - { - *format_ret = 16; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); - (*data_ret) [sizeof (short)] = 0; - (*(short **) data_ret) [0] = (short) XINT (obj); - if (NILP (type)) type = QINTEGER; - } - else if (INTP (obj) || CONSP (obj)) - { - *format_ret = 32; - *size_ret = 1; - *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); - (*data_ret) [sizeof (long)] = 0; - (*(unsigned long **) data_ret) [0] = lisp_to_word (obj); - if (NILP (type)) type = QINTEGER; - } - else if (VECTORP (obj)) - { - /* Lisp Vectors may represent a set of ATOMs; - a set of 16 or 32 bit INTEGERs; - or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...] - */ - int i; - - if (SYMBOLP (XVECTOR_DATA (obj) [0])) - /* This vector is an ATOM set */ - { - if (NILP (type)) type = QATOM; - *size_ret = XVECTOR_LENGTH (obj); - *format_ret = 32; - *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom)); - for (i = 0; i < (int) (*size_ret); i++) - if (SYMBOLP (XVECTOR_DATA (obj) [i])) - (*(GdkAtom **) data_ret) [i] = - symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0); - else - syntax_error - ("all elements of the vector must be of the same type", obj); - } -#if 0 /* #### MULTIPLE doesn't work yet */ - else if (VECTORP (XVECTOR_DATA (obj) [0])) - /* This vector is an ATOM_PAIR set */ - { - if (NILP (type)) type = QATOM_PAIR; - *size_ret = XVECTOR_LENGTH (obj); - *format_ret = 32; - *data_ret = (unsigned char *) - xmalloc ((*size_ret) * sizeof (Atom) * 2); - for (i = 0; i < *size_ret; i++) - if (VECTORP (XVECTOR_DATA (obj) [i])) - { - Lisp_Object pair = XVECTOR_DATA (obj) [i]; - if (XVECTOR_LENGTH (pair) != 2) - syntax_error - ("elements of the vector must be vectors of exactly two elements", pair); - - (*(GdkAtom **) data_ret) [i * 2] = - symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0); - (*(GdkAtom **) data_ret) [(i * 2) + 1] = - symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0); - } - else - syntax_error - ("all elements of the vector must be of the same type", obj); - } -#endif - else - /* This vector is an INTEGER set, or something like it */ - { - *size_ret = XVECTOR_LENGTH (obj); - if (NILP (type)) type = QINTEGER; - *format_ret = 16; - for (i = 0; i < (int) (*size_ret); i++) - if (CONSP (XVECTOR_DATA (obj) [i])) - *format_ret = 32; - else if (!INTP (XVECTOR_DATA (obj) [i])) - syntax_error - ("all elements of the vector must be integers or conses of integers", obj); - - *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8)); - for (i = 0; i < (int) (*size_ret); i++) - if (*format_ret == 32) - (*((unsigned long **) data_ret)) [i] = - lisp_to_word (XVECTOR_DATA (obj) [i]); - else - (*((unsigned short **) data_ret)) [i] = - (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]); - } - } - else - invalid_argument ("unrecognized selection data", obj); - - *type_ret = symbol_to_gtk_atom (d, type, 0); -} - - static Lisp_Object gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,