gdk-window-new options

[Kevin Ryde <user42 at zip dot com dot au>]

        * gdk-support.c (gdk_window_new_interp): Add remaining optional
        GdkWindowAttr keyword arguments, inline fill_window_attrs, no need to
        dup and free the title string, initialize keywords and use them in
        examining the args.
        * guile-gtk.h (sgtk_gdk_colormap_info, sgtk_gdk_cursor_info,
        sgtk_gdk_visual_info): Add declarations.

New code below.

I think the little keyword snarfer could be used in gtk-support.c too,
I suspect kw_flags and kw_type might be at risk of being garbage
collected.

extern sgtk_boxed_info sgtk_gdk_colormap_info;
extern sgtk_boxed_info sgtk_gdk_cursor_info;
extern sgtk_boxed_info sgtk_gdk_visual_info;


#define SGTK_KEYWORD(c_name, scheme_name)               \
SCM_SNARF_HERE(static SCM c_name)                       \
SCM_SNARF_INIT(c_name = scm_permanent_object            \
               (scm_make_keyword_from_dash_symbol       \
                (scm_str2symbol ("-" scheme_name))))

SGTK_KEYWORD (kw_colormap,          "colormap");
SGTK_KEYWORD (kw_cursor,            "cursor");
SGTK_KEYWORD (kw_override_redirect, "override-redirect");
SGTK_KEYWORD (kw_title,             "title");
SGTK_KEYWORD (kw_visual,            "visual");
SGTK_KEYWORD (kw_wmclass,           "wmclass");
SGTK_KEYWORD (kw_x,                 "x");
SGTK_KEYWORD (kw_y,                 "y");

/* The Gtk documentation doesn't seem to say whether NULL is allowed in the
   various fields of GdkWindowAttr.  The code looks like it's probably fine
   for the cursor, but not for the visual.  Let's insist on actual objects
   and strings for now.  */

GdkWindow *
gdk_window_new_interp (GdkWindow *parent, int width, int height,
		       GdkEventMask event_mask, GdkWindowClass window_class,
		       GdkWindowType window_type, SCM rest)
#define FUNC_NAME "gdk-window-new"
{
  GdkWindowAttr attr;
  gint mask;
  GdkWindow *w;
  SCM key, val;
  unsigned long argnum;

  attr.event_mask = event_mask;
  attr.width = width;
  attr.height = height;
  attr.wclass = window_class;
  attr.window_type = window_type;

  mask = 0;
  argnum = 6;
  for (;;)
    {
      if (! SCM_CONSP (rest))
        break;
      key = SCM_CAR (rest);
      rest = SCM_CDR (rest);

      if (! SCM_CONSP (rest))
	scm_misc_error (FUNC_NAME, "missing argument to keyword ~A",
			scm_list_1 (key));
      argnum += 2;
      val = SCM_CAR (rest);
      rest = SCM_CDR (rest);

      if (SCM_EQ_P (key, kw_colormap))
	{
          SCM_ASSERT (sgtk_valid_boxed (val, &sgtk_gdk_colormap_info),
                      val, argnum, FUNC_NAME);
          attr.colormap = (GdkColormap*) sgtk_scm2boxed (val);
	  mask |= GDK_WA_COLORMAP;
	}
      else if (SCM_EQ_P (key, kw_cursor))
	{
          SCM_ASSERT (sgtk_valid_boxed (val, &sgtk_gdk_cursor_info),
                      val, argnum, FUNC_NAME);
          attr.cursor = (GdkCursor*) sgtk_scm2boxed (val);
	  mask |= GDK_WA_CURSOR;
	}
      else if (SCM_EQ_P (key, kw_override_redirect))
	{
          attr.override_redirect = ! SCM_FALSEP (val);
	  mask |= GDK_WA_NOREDIR;
	}
      else if (SCM_EQ_P (key, kw_title))
	{
	  SCM_VALIDATE_STRING (argnum, val);
	  attr.title = SCM_STRING_CHARS (val);
	  mask |= GDK_WA_TITLE;
	}
      else if (SCM_EQ_P (key, kw_visual))
	{
          SCM_ASSERT (sgtk_valid_boxed (val, &sgtk_gdk_visual_info),
                      val, argnum, FUNC_NAME);
          attr.visual = (GdkVisual*) sgtk_scm2boxed (val);
	  mask |= GDK_WA_VISUAL;
	}
      else if (SCM_EQ_P (key, kw_wmclass))
	{
          SCM  val2;
          if (! SCM_CONSP (rest))
            scm_misc_error (FUNC_NAME, "missing second argument to keyword ~A",
                            scm_list_1 (key));
          val2 = SCM_CAR (rest);
          rest = SCM_CDR (rest);

	  SCM_VALIDATE_STRING (argnum, val);
          argnum++;
	  SCM_VALIDATE_STRING (argnum, val2);

          attr.wmclass_name = SCM_STRING_CHARS (val);
          attr.wmclass_class = SCM_STRING_CHARS (val);
	  mask |= GDK_WA_WMCLASS;
	}
      else if (SCM_EQ_P (key, kw_x))
	{
	  attr.x = scm_num2short (val, argnum, FUNC_NAME);
	  mask |= GDK_WA_X;
	}
      else if (SCM_EQ_P (key, kw_y))
	{
	  attr.y = scm_num2short (val, argnum, FUNC_NAME);
	  mask |= GDK_WA_Y;
	}
      else
	scm_misc_error (FUNC_NAME, "unknown keyword ~A", scm_list_1 (key));
    }

  w = gdk_window_new (parent, &attr, mask);

  /* ensure title string and boxed types are kept alive */
  scm_remember_upto_here (rest);

  return w;
}