view release on metacpan or  search on metacpan

GType.xs  view on Meta::CPAN

		sv = (SV*)ST (i+2);
		/* default to the i based numbering */
		values[i].value = 1 << i;
		if (gperl_sv_is_array_ref (sv))
		{
			/* [ name => value ] syntax */
			AV * av = (AV*)SvRV(sv);
			/* value_name */
			av2sv = av_fetch (av, 0, 0);
			if (av2sv && gperl_sv_is_defined (*av2sv))
				values[i].value_name = SvPV_nolen (*av2sv);
			else
				croak ("invalid flag name and value pair, no name provided");
			/* custom value */
			av2sv = av_fetch (av, 1, 0);
			if (av2sv && gperl_sv_is_defined (*av2sv))
				values[i].value = SvIV (*av2sv);
		}
		else if (gperl_sv_is_defined (sv))
		{
			/* name syntax */
			values[i].value_name = SvPV_nolen (sv);
		}
		else
			croak ("invalid type flag name");

		/* make sure that the nickname stays alive as long as the
		 * type is registered. */
		values[i].value_name = g_strdup (values[i].value_name);

		/* let the nick and name match.  there are few uses for the
		 * name, anyway. */
		values[i].value_nick = values[i].value_name;
	}
	ctype_name = sanitize_package_name (name);
	type = g_flags_register_static (ctype_name, values);
	gperl_register_fundamental (type, name);
	g_free (ctype_name);



=for apidoc

List the ancestry of I<package>, as seen by the GLib type system.  The
important difference is that GLib's type system implements only single
inheritance, whereas Perl's @ISA allows multiple inheritance.

This returns the package names of the ancestral types in reverse order, with
the root of the tree at the end of the list.

See also L<list_interfaces ()|/"list = Glib::Type-E<gt>B<list_interfaces> ($package)">.

=cut
void
list_ancestors (class, package)
	gchar * package
    PREINIT:
	GType        package_gtype;
	GType        parent_gtype;
	const char * pkg;
    PPCODE:
	package_gtype = gperl_type_from_package (package);
	XPUSHs (sv_2mortal (newSVpv (package, 0)));
	if (!package_gtype)
		croak ("%s is not registered with either GPerl or GLib",
		       package);
	parent_gtype = g_type_parent (package_gtype);
	while (parent_gtype)
	{
		pkg = gperl_package_from_type (parent_gtype);
		if (!pkg)
			croak("problem looking up parent package name, "
			      "gtype %lu", parent_gtype);
		XPUSHs (sv_2mortal (newSVpv (pkg, 0)));
		parent_gtype = g_type_parent (parent_gtype);
	}


=for apidoc

List the GInterfaces implemented by the type associated with I<package>.
The interfaces are returned as package names.

=cut
void
list_interfaces (class, package)
	gchar * package
    PREINIT:
	int     i;
	GType   package_gtype;
	GType * interfaces;
    PPCODE:
	package_gtype = gperl_type_from_package (package);
	if (!package_gtype)
		croak ("%s is not registered with either GPerl or GLib",
		       package);
	interfaces = g_type_interfaces (package_gtype, NULL);
	if (!interfaces)
		XSRETURN_EMPTY;
	for (i = 0; interfaces[i] != 0; i++) {
		const char * name = gperl_package_from_type (interfaces[i]);
		if (!name) {
			/* this is usually a sign that the bindings are
			 * missing something.  let's print a warning to make
			 * this easier to find. */
			name = g_type_name (interfaces[i]);
			warn ("GInterface %s is not registered with GPerl",
			      name);
		}
		XPUSHs (sv_2mortal (newSVpv (name, 0)));
	}
	g_free (interfaces);


=for apidoc

List the signals associated with I<package>.  This lists only the signals
for I<package>, not any of its parents.  The signals are returned as a list
of anonymous hashes which mirror the GSignalQuery structure defined in the
C API reference.

=over

=item - signal_id

Numeric id of a signal.  It's rare that you'll need this in Gtk2-Perl.

=item - signal_name

Name of the signal, such as what you'd pass to C<signal_connect>.

=item - itype

The I<i>nstance I<type> for which this signal is defined.

=item - signal_flags

GSignalFlags describing this signal.

=item - return_type

The return type expected from handlers for this signal.  If undef or not
present, then no return is expected.  The type name is mapped to the 
corresponding Perl package name if it is known, otherwise you get the
raw C name straight from GLib.

=item - param_types

The types of the parameters passed to any callbacks connected to the emission
of this signal.  The list does not include the instance, which is always
first, and the user data from C<signal_connect>, which is always last (unless
the signal was connected with "swap", which swaps the instance and the data,
but you get the point).

=back

=cut
void
list_signals (class, package)
	gchar * package
    PREINIT:
	guint          i, num;
	guint        * sigids;
	GType          package_type;
	GSignalQuery   siginfo;
	GObjectClass * oclass = NULL;
    PPCODE:
	package_type = gperl_type_from_package (package);
	if (!package_type)
		croak ("%s is not registered with either GPerl or GLib",
		       package);

	if (!G_TYPE_IS_INSTANTIATABLE(package_type) &&
	    !G_TYPE_IS_INTERFACE (package_type))
		XSRETURN_EMPTY;
	if (G_TYPE_IS_CLASSED (package_type)) {
		/* ref the class to ensure that the signals get created. */
		oclass = g_type_class_ref (package_type);
		if (!oclass)
			XSRETURN_EMPTY;
	}
	sigids = g_signal_list_ids (package_type, &num);
	if (!num)
		XSRETURN_EMPTY;
	EXTEND(SP, (int) num);
	for (i = 0; i < num; i++) {
		g_signal_query (sigids[i], &siginfo);
		PUSHs (sv_2mortal (newSVGSignalQuery (&siginfo)));
	}
	if (oclass)
		g_type_class_unref (oclass);


=for apidoc

List the legal values for the GEnum or GFlags type I<$package>.  If I<$package>
is not a package name registered with the bindings, this name is passed on to
g_type_from_name() to see if it's a registered flags or enum type that just
hasn't been registered with the bindings by C<gperl_register_fundamental()>
(see Glib::xsapi).  If I<$package> is not the name of an enum or flags type,
this function will croak.

Returns the values as a list of hashes, one hash for each value, containing
the value, name and nickname, eg. for Glib::SignalFlags

    { value => 8,
      name  => 'G_SIGNAL_NO_RECURSE',
      nick  => 'no-recurse'
    }

=cut
void
list_values (class, const char * package)
    PREINIT:
	GType type;
    PPCODE:
	type = gperl_fundamental_type_from_package (package);
	if (!type)
		type = g_type_from_name (package);
	if (!type)
		croak ("%s is not registered with either GPerl or GLib",
		       package);
	/*
	 * GFlagsValue and GEnumValue are nearly the same, but differ in
	 * that GFlagsValue is a guint for the value, but GEnumValue is gint
	 * (and some enums do indeed use negatives, eg. GtkResponseType).
	 */
	if (G_TYPE_IS_ENUM (type)) {
		GEnumValue * v = gperl_type_enum_get_values (type);
		for ( ; v && v->value_nick && v->value_name ; v++) {
			HV * hv = newHV ();
			gperl_hv_take_sv_s (hv, "value", newSViv (v->value));
			gperl_hv_take_sv_s (hv, "nick", newSVpv (v->value_nick, 0));
			gperl_hv_take_sv_s (hv, "name", newSVpv (v->value_name, 0));
			XPUSHs (sv_2mortal (newRV_noinc ((SV*)hv)));
		}
	} else if (G_TYPE_IS_FLAGS (type)) {
		GFlagsValue * v = gperl_type_flags_get_values (type);
		for ( ; v && v->value_nick && v->value_name ; v++) {
			HV * hv = newHV ();
			gperl_hv_take_sv_s (hv, "value", newSVuv (v->value));
			gperl_hv_take_sv_s (hv, "nick", newSVpv (v->value_nick, 0));
			gperl_hv_take_sv_s (hv, "name", newSVpv (v->value_name, 0));
			XPUSHs (sv_2mortal (newRV_noinc ((SV*)hv)));
		}
	} else {
		croak ("%s is neither enum nor flags type", package);
	}


=for apidoc

Convert a C type name to the corresponding Perl package name.  If no package
is registered to that type, returns I<$cname>. 

=cut
const char *
package_from_cname (class, const char * cname)
    PREINIT:
	GType gtype;
    CODE:
	gtype = g_type_from_name (cname);
	if (!gtype) {
		croak ("%s is not registered with the GLib type system",
		       cname);
		RETVAL = cname;
	} else {
		RETVAL = gperl_package_from_type (gtype);
		if (!RETVAL)
			RETVAL = cname;
	}
    OUTPUT:
	RETVAL

MODULE = Glib::Type	PACKAGE = Glib::Flags