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,