--- a/src/ChangeLog	Tue Jan 27 13:00:42 2004 +0000
+++ b/src/ChangeLog	Tue Jan 27 13:13:45 2004 +0000
@@ -1,3 +1,10 @@
+2004-01-16  Malcolm Purvis  <malcolmpurvis@optushome.com.au>
+
+	* ui-gtk.c (__internal_callback_marshal): Marshalling data to
+	return to GTK requires a different API to marshalling data to use
+	as GTK parameters.
+	* ui-gtk.c (lisp_to_gtk_ret_type): New. 
+
 2004-01-23  Stephen J. Turnbull  <stephen@xemacs.org>
 
 	* specifier.c (Fvalid_specifier_type_p): Fix docstring typo.

--- a/src/ui-gtk.c	Tue Jan 27 13:00:42 2004 +0000
+++ b/src/ui-gtk.c	Tue Jan 27 13:13:45 2004 +0000
@@ -37,6 +37,7 @@
 
 Lisp_Object gtk_type_to_lisp (GtkArg *arg);
 int lisp_to_gtk_type (Lisp_Object obj, GtkArg *arg);
+int lisp_to_gtk_ret_type (Lisp_Object obj, GtkArg *arg);
 #if 0
 void describe_gtk_arg (GtkArg *arg);
 #endif
@@ -1042,7 +1043,7 @@
   signal_fake_event ();
 
   if (args[n_args].type != GTK_TYPE_NONE)
-    lisp_to_gtk_type (rval, &args[n_args]);
+    lisp_to_gtk_ret_type (rval, &args[n_args]);
 
   UNGCPRO;
 }
@@ -1807,6 +1808,286 @@
   return (0);
 }
 
+/* Convert lisp types to GTK return types.  This is identical to
+   lisp_to_gtk_type() except that the macro used to set the value is
+   different.
+
+   ### There should be some way of combining these two functions.
+*/
+int lisp_to_gtk_ret_type (Lisp_Object obj, GtkArg *arg)
+{
+  switch (GTK_FUNDAMENTAL_TYPE (arg->type))
+    {
+      /* flag types */
+    case GTK_TYPE_NONE:
+      return (0);
+    case GTK_TYPE_CHAR:
+      {
+	Ichar c;
+
+	CHECK_CHAR_COERCE_INT (obj);
+	c = XCHAR (obj);
+	*(GTK_RETLOC_CHAR (*arg)) = c;
+      }
+      break;
+    case GTK_TYPE_UCHAR:
+      {
+	Ichar c;
+
+	CHECK_CHAR_COERCE_INT (obj);
+	c = XCHAR (obj);
+	*(GTK_RETLOC_CHAR (*arg)) = c;
+      }
+      break;
+    case GTK_TYPE_BOOL:
+      *(GTK_RETLOC_BOOL (*arg)) = NILP (obj) ? FALSE : TRUE;
+      break;
+    case GTK_TYPE_INT:
+    case GTK_TYPE_UINT:
+      if (NILP (obj) || EQ (Qt, obj))
+	{
+	  /* For we are a kind mistress and allow sending t/nil for
+             1/0 to stupid GTK functions that say they take guint or
+             gint in the header files, but actually treat it like a
+             bool.  *sigh*
+	  */
+	  *(GTK_RETLOC_INT(*arg)) = NILP (obj) ? 0 : 1;
+	}
+      else
+	{
+	  CHECK_INT (obj);
+	  *(GTK_RETLOC_INT(*arg)) = XINT (obj);
+	}
+      break;
+    case GTK_TYPE_LONG:
+    case GTK_TYPE_ULONG:
+      abort();
+    case GTK_TYPE_FLOAT:
+      CHECK_INT_OR_FLOAT (obj);
+      *(GTK_RETLOC_FLOAT(*arg)) = extract_float (obj);
+      break;
+    case GTK_TYPE_DOUBLE:
+      CHECK_INT_OR_FLOAT (obj);
+      *(GTK_RETLOC_DOUBLE(*arg)) = extract_float (obj);
+      break;
+    case GTK_TYPE_STRING:
+      if (NILP (obj))
+	*(GTK_RETLOC_STRING (*arg)) = NULL;
+      else
+	{
+	  CHECK_STRING (obj);
+	  *(GTK_RETLOC_STRING (*arg)) = (char *) XSTRING_DATA (obj);
+	}
+      break;
+    case GTK_TYPE_ENUM:
+    case GTK_TYPE_FLAGS:
+      /* Convert a lisp symbol to a GTK enum */
+      *(GTK_RETLOC_ENUM(*arg)) = lisp_to_flag (obj, arg->type);
+      break;
+    case GTK_TYPE_BOXED:
+      if (NILP (obj))
+	{
+	  *(GTK_RETLOC_BOXED(*arg)) = NULL;
+	}
+      else if (GTK_BOXEDP (obj))
+	{
+	  *(GTK_RETLOC_BOXED(*arg)) = XGTK_BOXED (obj)->object;
+	}
+      else if (arg->type == GTK_TYPE_STYLE)
+	{
+	  obj = Ffind_face (obj);
+	  CHECK_FACE (obj);
+	  *(GTK_RETLOC_BOXED(*arg)) = face_to_style (obj);
+	}
+      else if (arg->type == GTK_TYPE_GDK_GC)
+	{
+	  obj = Ffind_face (obj);
+	  CHECK_FACE (obj);
+	  *(GTK_RETLOC_BOXED(*arg)) = face_to_gc (obj);
+	}
+      else if (arg->type == GTK_TYPE_GDK_WINDOW)
+	{
+	  if (GLYPHP (obj))
+	    {
+	      Lisp_Object window = Fselected_window (Qnil);
+	      Lisp_Object instance =
+		glyph_image_instance (obj, window, ERROR_ME_DEBUG_WARN, 1);
+	      struct Lisp_Image_Instance *p = XIMAGE_INSTANCE (instance);
+
+	      switch (XIMAGE_INSTANCE_TYPE (instance))
+		{
+		case IMAGE_TEXT:
+		case IMAGE_POINTER:
+		case IMAGE_SUBWINDOW:
+		case IMAGE_NOTHING:
+		  *(GTK_RETLOC_BOXED(*arg)) = NULL;
+		  break;
+
+		case IMAGE_MONO_PIXMAP:
+		case IMAGE_COLOR_PIXMAP:
+		  *(GTK_RETLOC_BOXED(*arg)) = IMAGE_INSTANCE_GTK_PIXMAP (p);
+		  break;
+		}
+	    }
+	  else if (GTK_OBJECTP (obj) && GTK_IS_WIDGET (XGTK_OBJECT (obj)->object))
+	    {
+	      *(GTK_RETLOC_BOXED(*arg)) = GTK_WIDGET (XGTK_OBJECT (obj))->window;
+	    }
+	  else
+	    {
+	      invalid_argument ("Don't know how to convert object to GDK_WINDOW", obj);
+	    }
+	  break;
+	}
+      else if (arg->type == GTK_TYPE_GDK_COLOR)
+	{
+	  if (COLOR_SPECIFIERP (obj))
+	    {
+	      /* If it is a specifier, we just convert it to an
+                 instance, and let the ifs below handle it.
+	      */
+	      obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
+	    }
+	  
+	  if (COLOR_INSTANCEP (obj))
+	    {
+	      /* Easiest one */
+	      *(GTK_RETLOC_BOXED(*arg)) = COLOR_INSTANCE_GTK_COLOR (XCOLOR_INSTANCE (obj));
+	    }
+	  else if (STRINGP (obj))
+	    {
+	      invalid_argument ("Please use a color specifier or instance, not a string", obj);
+	    }
+	  else
+	    {
+	      invalid_argument ("Don't know how to convert to GdkColor", obj);
+	    }
+	}
+      else if (arg->type == GTK_TYPE_GDK_FONT)
+	{
+	  if (SYMBOLP (obj))
+	    {
+	      /* If it is a symbol, we treat that as a face name */
+	      obj = Ffind_face (obj);
+	    }
+
+	  if (FACEP (obj))
+	    {
+	      /* If it is a face, we just grab the font specifier, and
+                 cascade down until we finally reach a FONT_INSTANCE
+	      */
+	      obj = Fget (obj, Qfont, Qnil);
+	    }
+
+	  if (FONT_SPECIFIERP (obj))
+	    {
+	      /* If it is a specifier, we just convert it to an
+                 instance, and let the ifs below handle it
+	      */
+	      obj = Fspecifier_instance (obj, Qnil, Qnil, Qnil);
+	    }
+
+	  if (FONT_INSTANCEP (obj))
+	    {
+	      /* Easiest one */
+	      *(GTK_RETLOC_BOXED(*arg)) = FONT_INSTANCE_GTK_FONT (XFONT_INSTANCE (obj));
+	    }
+	  else if (STRINGP (obj))
+	    {
+	      invalid_argument ("Please use a font specifier or instance, not a string", obj);
+	    }
+	  else
+	    {
+	      invalid_argument ("Don't know how to convert to GdkColor", obj);
+	    }
+	}
+      else
+	{
+	  /* Unknown type to convert to boxed */
+	  stderr_out ("Don't know how to convert to boxed!\n");
+	  *(GTK_RETLOC_BOXED(*arg)) = NULL;
+	}
+      break;
+
+    case GTK_TYPE_POINTER:
+      if (NILP (obj))
+	*(GTK_RETLOC_POINTER(*arg)) = NULL;
+      else
+	*(GTK_RETLOC_POINTER(*arg)) = LISP_TO_VOID (obj);
+      break;
+
+      /* structured types */
+    case GTK_TYPE_SIGNAL:
+    case GTK_TYPE_ARGS: /* This we can do as a list of values */
+    case GTK_TYPE_C_CALLBACK:
+    case GTK_TYPE_FOREIGN:
+      stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
+      return (-1);
+
+#if 0
+      /* #### BILL! */
+      /* This is not used, and does not work with union type */
+    case GTK_TYPE_CALLBACK:
+      {
+	GUI_ID id;
+
+	id = new_gui_id ();
+	obj = Fcons (Qnil, obj); /* Empty data */
+	obj = Fcons (make_int (id), obj);
+
+	gcpro_popup_callbacks (id, obj);
+
+	*(GTK_RETLOC_CALLBACK(*arg)).marshal = __internal_callback_marshal;
+	*(GTK_RETLOC_CALLBACK(*arg)).data = (gpointer) obj;
+	*(GTK_RETLOC_CALLBACK(*arg)).notify = __internal_callback_destroy;
+      }
+      break;
+#endif
+
+      /* base type of the object system */
+    case GTK_TYPE_OBJECT:
+      if (NILP (obj))
+	*(GTK_RETLOC_OBJECT (*arg)) = NULL;
+      else
+	{
+	  CHECK_GTK_OBJECT (obj);
+	  if (XGTK_OBJECT (obj)->alive_p)
+	    *(GTK_RETLOC_OBJECT (*arg)) = XGTK_OBJECT (obj)->object;
+	  else
+	    invalid_argument ("Attempting to pass dead object to GTK function", obj);
+	}
+      break;
+
+    default:
+      if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_ARRAY)
+	{
+	  if (NILP (obj))
+	    *(GTK_RETLOC_POINTER(*arg)) = NULL;
+	  else
+	    {
+	      xemacs_list_to_array (obj, arg);
+	    }
+	}
+      else if (GTK_FUNDAMENTAL_TYPE (arg->type) == GTK_TYPE_LISTOF)
+	{
+	  if (NILP (obj))
+	    *(GTK_RETLOC_POINTER(*arg)) = NULL;
+	  else
+	    {
+	      xemacs_list_to_gtklist (obj, arg);
+	    }
+	}
+      else
+	{
+	  stderr_out ("Do not know how to convert `%s' from lisp!\n", gtk_type_name (arg->type));
+	  abort();
+	}
+      break;
+    }
+
+  return (0);
+}
+
 /* This is used in glyphs-gtk.c as well */
 static Lisp_Object
 get_enumeration (GtkType t)