view release on metacpan or  search on metacpan

xs/GtkBuildable.xs  view on Meta::CPAN

		     gperl_package_from_type (G_OBJECT_TYPE (obj)), name);

#define PREP(obj) \
	dSP; \
	ENTER; \
	SAVETMPS; \
	PUSHMARK (SP) ; \
	PUSHs (sv_2mortal (newSVGObject (G_OBJECT (obj))));

#define CALL_VOID \
	PUTBACK; \
	call_sv ((SV *) GvCV (slot), G_VOID | G_DISCARD);

#define CALL_SCALAR(sv) \
	PUTBACK; \
	(void) call_sv ((SV *) GvCV (slot), G_SCALAR); \
	SPAGAIN; \
	sv = POPs; \
	PUTBACK;

#define FINISH \
	FREETMPS; \
	LEAVE;

static void          
gtk2perl_buildable_set_name (GtkBuildable  *buildable,
                             const gchar   *name)
{
	GET_METHOD (buildable, "SET_NAME");

	if (METHOD_EXISTS) {
		PREP (buildable);
		XPUSHs (sv_2mortal (newSVGChar (name)));
		CALL_VOID;
		FINISH;
	} else {
		/* Convenient fallback for mere mortals who need nothing
		   complicated.  This is the same as in the upstream
		   implementation. */
		g_object_set_data_full (G_OBJECT (buildable),
				        "gtk-builder-name",
					g_strdup (name),
					g_free);
	}
}

static const gchar * 
gtk2perl_buildable_get_name (GtkBuildable  *buildable)
{
	const gchar * name;

	GET_METHOD (buildable, "GET_NAME");

	if (METHOD_EXISTS) {
		SV * sv;

		PREP (buildable);
		CALL_SCALAR (sv);
		/*
		 * the interface wants us to return a const pointer, which
		 * means this needs to stay alive.  Unfortunately, we can't
		 * guarantee that the scalar will still be around by the
		 * time the string is used.  My first thought here was to
		 * use gperl_alloc_temp(), but that suffered the same
		 * lifetime issue, because the string was immediately
		 * returned to perl code, which meant that the temp was
		 * cleaned up an reused before the string was read.
		 * So, we'll go a little nuts and store a malloc'd copy
		 * of the string until the next call.  In theory, some
		 * code might be crazy enough to return a different name
		 * on the second call, so we won't bother with real caching.
		 */
		name = g_strdup (SvGChar (sv));
		g_object_set_data_full (G_OBJECT (buildable),
				        "gtk-perl-builder-name",
				        g_strdup (name),
					g_free);
		FINISH;

	} else {
		/* Convenient fallback for mere mortals who need nothing
		   complicated.  This is the same as in the upstream
		   implementation. */
		name = (const gchar *) g_object_get_data (G_OBJECT (buildable),
							  "gtk-builder-name");
	}

	return name;
}

static void          
gtk2perl_buildable_add_child (GtkBuildable  *buildable,
			      GtkBuilder    *builder,
			      GObject       *child,
			      const gchar   *type)
{
	GET_METHOD_OR_DIE (buildable, "ADD_CHILD");

	{
		PREP (buildable);
		XPUSHs (sv_2mortal (newSVGtkBuilder (builder)));
		XPUSHs (sv_2mortal (newSVGObject (child)));
		XPUSHs (sv_2mortal (newSVGChar (type)));
		CALL_VOID;
		FINISH;
	}
}

static void          
gtk2perl_buildable_set_buildable_property (GtkBuildable  *buildable,
					   GtkBuilder    *builder,
					   const gchar   *name,
					   const GValue  *value)
{
	GET_METHOD (buildable, "SET_BUILDABLE_PROPERTY");

	if (METHOD_EXISTS) {
		PREP (buildable);
		XPUSHs (sv_2mortal (newSVGtkBuilder (builder)));
		XPUSHs (sv_2mortal (newSVGChar (name)));
		XPUSHs (sv_2mortal (gperl_sv_from_value (value)));