Allow perl code to implement the GtkBuildableIface. Lots of documentation. Hide docs for the normal GtkBuildable methods, as they are really only useful for GtkBuilder to call. Add a new unit test for the iface stuff. This patch requires the deferral of class instantiation in Glib::Type::register_object() if you are going to implement the interface on a class derived from a class that already implements that interface (e.g., if you want to implement Buildable on a Widget). Index: MANIFEST =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/MANIFEST,v retrieving revision 1.103 diff -p -u -r1.103 MANIFEST --- MANIFEST 8 Jan 2008 05:33:46 -0000 1.103 +++ MANIFEST 9 Jan 2008 04:55:38 -0000 @@ -151,6 +151,7 @@ t/GtkAssistant.t t/GtkBin.t t/GtkBox.t t/GtkBuildable.t +t/GtkBuildableIface.t t/GtkBuilder.t t/GtkButton.t t/GtkButtonBox.t Index: t/GtkBuildableIface.t =================================================================== RCS file: t/GtkBuildableIface.t diff -N t/GtkBuildableIface.t --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ t/GtkBuildableIface.t 9 Jan 2008 04:55:38 -0000 @@ -0,0 +1,363 @@ +#!/usr/bin/perl +# vim: set filetype=perl expandtab softtabstop=4 shiftwidth=4 : + +package TestThing; + +use strict; +use warnings; +use Gtk2; +use Test::More; +use Glib ':constants'; + +BEGIN { +Glib::Type->register_enum ('TestThing::Stuff', qw( left right top bottom )); +} + +use Glib::Object::Subclass + Glib::Object::, + signals => { + changed => {}, + }, + properties => [ + Glib::ParamSpec->int ('a', 'A', 'A', 1, 10, 5, G_PARAM_READWRITE), + Glib::ParamSpec->string ('b', 'B', 'B', "whee", G_PARAM_READWRITE), + Glib::ParamSpec->enum ('c', 'C', 'C', 'TestThing::Stuff', 'top', + G_PARAM_READWRITE), + ], + interfaces => [ + Gtk2::Buildable::, + ], + ; + +sub changed { + my $self = shift; + $self->signal_emit ('changed'); +} + +package TestThingView; + +use strict; +use warnings; +use Gtk2; +use Test::More; +use Glib ':constants'; + +use Glib::Object::Subclass + Gtk2::Table::, + signals => { + }, + properties => [ + Glib::ParamSpec->object ('thing', 'Thing', 'The Thing', + TestThing::, G_PARAM_READWRITE), + Glib::ParamSpec->string ('color-string', 'Color String', 'duh', + "red", G_PARAM_READWRITE), + ], + # NOTE: we DON't implement Buildable here, we inherit it from Gtk2::Widget + ; + +package TestComplexThing; + +use strict; +use warnings; +use Gtk2; +use Test::More; +use Glib ':constants'; + +use Glib::Object::Subclass + Glib::Object::, + signals => { + }, + properties => [ + ], + # Here we'll override some of the interface methods directly + interfaces => [ + Gtk2::Buildable::, + ], + ; + +sub SET_NAME { + my ($self, $name) = @_; + $self->{name} = $name; +} + +sub GET_NAME { + my $self = shift; + return $self->{name}; +} + +sub ADD_CHILD { + my ($self, $builder, $child, $type) = @_; + print "ADD_CHILD $child\n"; +} + +sub SET_BUILDABLE_PROPERTY { + print "SET_BUILDABLE_PROPERTY\n"; +} + +{ + package TestComplexThing::OptionParser; + + use strict; + use warnings; + + sub new { + my $class = shift; + return bless { @_ }, $class; + } + + sub START_ELEMENT { + my ($self, $context, $tagname, $attributes) = @_; + + print "START_ELEMENT $tagname name=\"$attributes->{name}\"\n"; + print " ".$context->get_element."\n"; + print " ".join(":", $context->get_position)."\n"; + print " ".join("/", reverse $context->get_element_stack)."\n" + if $context->can ('get_element_stack'); + + $self->{tagname} = $tagname; + $self->{attributes} = $attributes; + } + + sub TEXT { + my ($self, $context, $text) = @_; + + print "TEXT ".$self->{tagname}."\n"; + + $self->{text} = '' if not defined $self->{text}; + $self->{text} .= $text; + } + + sub END_ELEMENT { + print "END_ELEMENT ".$_[0]{tagname}."\n"; + } + + sub DESTROY { + print "DESTROY ".$_[0]{tagname}."\n"; + } +} + +sub CUSTOM_TAG_START { + my ($self, $builder, $child, $tagname) = @_; + + print "CUSTOM_TAG_START $tagname\n"; + + isa_ok ($self, TestComplexThing::); + isa_ok ($self, Gtk2::Buildable::); + isa_ok ($self, Glib::Object::); + + isa_ok ($builder, Gtk2::Builder::); + + ok (not defined $child); + + is ($tagname, 'option'); + + return TestComplexThing::OptionParser->new (); +} + +sub CUSTOM_TAG_END { + my ($self, $builder, $child, $tagname, $parser) = @_; + + print "CUSTOM_TAG_END $tagname\n"; + + isa_ok ($self, TestComplexThing::); + isa_ok ($builder, Gtk2::Builder::); + ok (not defined $child); + is ($tagname, 'option'); + isa_ok ($parser, TestComplexThing::OptionParser::); + + $self->{options}{$parser->{attributes}{name}} = $parser->{text}; + $self->{selected} = $parser->{attributes}{name} + if $parser->{attributes}{selected}; +} + +sub CUSTOM_FINISHED { + my ($self, $builder, $child, $tagname, $parser) = @_; + + print "CUSTOM_FINISHED $tagname\n"; + + isa_ok ($self, TestComplexThing::); + isa_ok ($builder, Gtk2::Builder::); + ok (not defined $child); + is ($tagname, 'option'); + isa_ok ($parser, TestComplexThing::OptionParser::); +} + +sub PARSER_FINISHED { + my ($self, $builder) = @_; + + print "PARSER_FINISHED\n"; +} + +sub GET_INTERNAL_CHILD { + my ($self, $builder, $childname) = @_; + + print "GET_INTERNAL_CHILD $childname\n"; + + return undef; +} + + +package TestComplexWidget; + +use strict; +use warnings; +use Gtk2; +use Test::More; +use Glib ':constants'; + +use Glib::Object::Subclass + Gtk2::Frame::, + signals => { + }, + properties => [ + ], + # Here we'll override some of the interface methods directly + interfaces => [ + Gtk2::Buildable::, + ], + ; + +sub SET_NAME { + my ($self, $name) = @_; + + isa_ok ($self, TestComplexWidget::); + isa_ok ($self, Gtk2::Buildable::); + isa_ok ($self, Gtk2::Frame::); + + $self->{name} = $name; +} + +sub GET_NAME { + my $self = shift; + + isa_ok ($self, TestComplexWidget::); + isa_ok ($self, Gtk2::Buildable::); + isa_ok ($self, Gtk2::Frame::); + + return $self->{name}; +} + +sub ADD_CHILD { + my ($self, $builder, $child, $type) = @_; + + isa_ok ($self, TestComplexWidget::); + isa_ok ($self, Gtk2::Buildable::); + isa_ok ($self, Gtk2::Frame::); + + isa_ok ($builder, Gtk2::Builder::); + + isa_ok ($child, Gtk2::Widget::); + + if (defined ($type)) { + if ($type eq 'label') { + $self->set_label_widget ($child); + } else { + ok (0, "Unknown internal child type"); + } + } else { + $self->add ($child); + } +} + +sub SET_BUILDABLE_PROPERTY { + my ($self, $builder, $name, $value) = @_; + + isa_ok ($self, TestComplexWidget::); + isa_ok ($self, Gtk2::Buildable::); + isa_ok ($self, Gtk2::Frame::); + + isa_ok ($builder, Gtk2::Builder::); + + ok (defined $name); + + $self->set ($name, $value); +} + +package main; + +use strict; +use warnings; +use Gtk2::TestHelper tests => 89; + +my $builder = Gtk2::Builder->new (); + +my $ui = < + + 7 + ftang + left + + + + + FALSE + thing1 + purple + + + + + + + + + + in + + + Woohoo + + + + + <b>Bold text</b> + TRUE + + + + +EOD + +$builder->add_from_string ($ui); +$builder->connect_signals (); + + +my $thing1 = $builder->get_object ('thing1'); +isa_ok ($thing1, TestThing::); +is ($thing1->get_name(), 'thing1'); +is ($thing1->get ('a'), 7); +is ($thing1->get ('b'), 'ftang'); +is ($thing1->get ('c'), 'left'); +$thing1->changed (); + +sub on_thing1_changed { + my $thing = shift; + ok (1, "on_thing1_changed connected correctly"); + isa_ok ($thing, TestThing::); +} + + +my $view1 = $builder->get_object ('view1'); +isa_ok ($view1, TestThingView::); +is ($view1->get_name (), 'view1'); +ok (! $view1->get ('visible')); +is ($view1->get ('thing'), $thing1); +is ($view1->get ('color-string'), 'purple'); + + +my $fancything = $builder->get_object ('fancy-thing'); +isa_ok ($fancything, TestComplexThing::); +is ($fancything->get_name (), 'fancy-thing'); +use Data::Dumper; +print Dumper($fancything); +is ($fancything->{options}{x}, 10); +is ($fancything->{options}{y}, 15); +is ($fancything->{options}{z}, 20); +is ($fancything->{selected}, 'y'); + + + +my $fancywidget = $builder->get_object ('fancy-widget'); +isa_ok ($fancywidget, TestComplexWidget::); +is ($fancywidget->get_name (), 'fancy-widget'); Index: xs/GtkBuildable.xs =================================================================== RCS file: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/xs/GtkBuildable.xs,v retrieving revision 1.1 diff -p -u -r1.1 GtkBuildable.xs --- xs/GtkBuildable.xs 19 Jun 2007 17:55:32 -0000 1.1 +++ xs/GtkBuildable.xs 9 Jan 2008 04:55:38 -0000 @@ -8,20 +8,601 @@ #include "gtk2perl.h" + + +/* + Since perl already has a metric ton of XML parsers, Glib doesn't + wrap GMarkupParser. This is a miniature binding of just the bits + of GMarkupParser that GtkBuildable needs. The GMarkupParseContext + is blessed as a Gtk2::Builder::ParseContext, and has only the + user-usable methods bound. (Should it happen that we need to bind + GMarkupParseContext in Glib in the future, we can just move those + methods to Glib, and have Gtk2::Builder::ParseContext inherit + from Glib::Markup::ParseContext.) + + Builder doesn't use passthrough() and error(), but they were easy + to implement and will be there if and when Builder does start to + use them. + */ + +static SV * +newSVGtkBuildableParseContext (GMarkupParseContext * context) +{ + return sv_setref_pv (newSV (0), "Gtk2::Buildable::ParseContext", context); +} + +static GMarkupParseContext * +SvGtkBuildableParseContext (SV * sv) +{ + if (! gperl_sv_is_defined (sv) || ! SvROK (sv)) + croak ("expected a blessed reference"); + + if (! sv_derived_from (sv, "Gtk2::Buildable::ParseContext")) + croak ("%s is not of type Gtk2::Buildable::ParseContext", + gperl_format_variable_for_output (sv)); + + return INT2PTR (GMarkupParseContext *, SvIV (SvRV (sv))); +} + + + +static SV * +check_parser (gpointer user_data) +{ + SV * sv = user_data; + + if (! gperl_sv_is_defined (sv) || ! SvROK (sv)) + croak ("parser object is not an object"); + + return sv; +} + +/* + * Treat parser as an SV object, and call method on it in void context, with + * the extra args from the va list. You are expected to do any necessary + * sv_2mortal() and such on those. An will be converted to a GError. + */ +static void +call_parser_method (GError ** error, + gpointer parser, + GMarkupParseContext * context, + const char * method, + int n_args, + ...) +{ + va_list ap; + dSP; + + ENTER; + SAVETMPS; + PUSHMARK (SP); + + EXTEND (SP, 2 + n_args); + + PUSHs (check_parser (parser)); + PUSHs (sv_2mortal (newSVGtkBuildableParseContext (context))); + + va_start (ap, n_args); + while (n_args-- > 0) { + SV * sv = va_arg (ap, SV *); + PUSHs (sv); + } + va_end (ap); + + PUTBACK; + + call_method (method, G_VOID | G_DISCARD | G_EVAL); + + SPAGAIN; + + if (SvTRUE (ERRSV)) { + if (SvROK (ERRSV) && sv_derived_from (ERRSV, "Glib::Error")) { + gperl_gerror_from_sv (ERRSV, error); + } else { + /* g_error_new_literal() won't let us pass 0 for + * the domain... */ + g_set_error (error, 0, 0, "%s", SvPV_nolen (ERRSV)); + } + } + + FREETMPS; + LEAVE; +} + +/* Called for open tags */ +static void +gtk2perl_buildable_parser_start_element (GMarkupParseContext *context, + const gchar *element_name, + const gchar **attribute_names, + const gchar **attribute_values, + gpointer user_data, + GError **error) +{ + HV * hv; + SV * attrs; + int i; + + hv = newHV (); + attrs = newRV_noinc ((SV *) hv); + + for (i = 0; attribute_names[i] != NULL ; i++) + hv_store (hv, + attribute_names[i], + strlen (attribute_names[i]), + newSVGChar (attribute_values[i]), + 0); + + call_parser_method (error, + user_data, + context, + "START_ELEMENT", + 2, + sv_2mortal (newSVGChar (element_name)), + sv_2mortal (attrs)); +} + +/* Called for close tags */ +static void +gtk2perl_buildable_parser_end_element (GMarkupParseContext *context, + const gchar *element_name, + gpointer user_data, + GError **error) +{ + call_parser_method (error, + user_data, + context, + "END_ELEMENT", + 1, + sv_2mortal (newSVGChar (element_name))); +} + +/* Called for character data */ +/* text is not nul-terminated */ +void +gtk2perl_buildable_parser_text (GMarkupParseContext *context, + const gchar *text, + gsize text_len, + gpointer user_data, + GError **error) +{ + SV * text_sv; + + text_sv = newSVpv (text, text_len); + SvUTF8_on (text_sv); + + call_parser_method (error, + user_data, + context, + "TEXT", + 1, + sv_2mortal (text_sv)); +} + +/* Called for strings that should be re-saved verbatim in this same + * position, but are not otherwise interpretable. At the moment + * this includes comments and processing instructions. + */ +/* text is not nul-terminated. */ +void +gtk2perl_buildable_parser_passthrough (GMarkupParseContext *context, + const gchar *passthrough_text, + gsize text_len, + gpointer user_data, + GError **error) +{ + SV * text_sv; + + text_sv = newSVpv (passthrough_text, text_len); + SvUTF8_on (text_sv); + + call_parser_method (error, + user_data, + context, + "PASSTHROUGH", + 1, + sv_2mortal (text_sv)); +} + +/* Called on error, including one set by other + * methods in the vtable. The GError should not be freed. + */ +void +gtk2perl_buildable_parser_error (GMarkupParseContext *context, + GError *error, + gpointer user_data) +{ + dSP; + + ENTER; + SAVETMPS; + PUSHMARK (SP); + + EXTEND (SP, 2); + + PUSHs (check_parser (user_data)); + PUSHs (sv_2mortal (newSVGtkBuildableParseContext (context))); + PUSHs (sv_2mortal (gperl_sv_from_gerror (error))); + + PUTBACK; + + call_method ("ERROR", G_VOID | G_DISCARD); + + SPAGAIN; + + FREETMPS; + LEAVE; + + PERL_UNUSED_VAR (context); +} + +static const GMarkupParser mini_markup_parser = { + gtk2perl_buildable_parser_start_element, + gtk2perl_buildable_parser_end_element, + gtk2perl_buildable_parser_text, + gtk2perl_buildable_parser_passthrough, + gtk2perl_buildable_parser_error +}; + + + +/* + * Now, support for GtkBuildableIface. + */ + +#define GET_METHOD(object, name) \ + HV * stash = gperl_object_stash_from_type (G_OBJECT_TYPE (object)); \ + GV * slot = gv_fetchmethod (stash, name); + +#define METHOD_EXISTS (slot && GvCV (slot)) + +#define GET_METHOD_OR_DIE(obj, name) \ + GET_METHOD (obj, name); \ + if (! METHOD_EXISTS) \ + die ("No implementation for %s::%s\n", \ + 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))); + CALL_VOID; + FINISH; + } else + g_object_set_property (G_OBJECT (buildable), name, value); +} + +/* Nobody should really ever need this one; it's a special case for + * GtkUIManager... but, just in case. */ +static GObject * +gtk2perl_buildable_construct_child (GtkBuildable *buildable, + GtkBuilder *builder, + const gchar *name) +{ + GObject * child; + + GET_METHOD_OR_DIE (buildable, "CONSTRUCT_CHILD"); + + { + SV * sv; + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + XPUSHs (sv_2mortal (newSVGChar (name))); + CALL_SCALAR (sv); + child = SvGObject (sv); + FINISH; + } + + return child; +} + +static gboolean +gtk2perl_buildable_custom_tag_start (GtkBuildable *buildable, + GtkBuilder *builder, + GObject *child, + const gchar *tagname, + GMarkupParser *parser, + gpointer *data) +{ + gboolean ret = FALSE; + + *data = NULL; + memset (parser, 0, sizeof (*parser)); + + GET_METHOD_OR_DIE (buildable, "CUSTOM_TAG_START"); + + { + SV * sv; + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + XPUSHs (sv_2mortal (newSVGObject (child))); + XPUSHs (sv_2mortal (newSVGChar (tagname))); + CALL_SCALAR (sv); + if (gperl_sv_is_defined (sv)) { + ret = TRUE; + + /* keep it... we'll destroy it in custom-finished, + * below, regardless of whether the perl code + * actually does anything with it. */ + *data = newSVsv (sv); + + *parser = mini_markup_parser; + } + FINISH; + } + + return ret; +} + +static void +gtk2perl_buildable_custom_tag_end (GtkBuildable *buildable, + GtkBuilder *builder, + GObject *child, + const gchar *tagname, + gpointer *data) +{ + GET_METHOD (buildable, "CUSTOM_TAG_END"); + + if (METHOD_EXISTS) { + SV * parser = gperl_sv_is_defined ((SV *) data) + ? (SV *) data : &PL_sv_undef; + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + XPUSHs (sv_2mortal (newSVGObject (child))); + XPUSHs (sv_2mortal (newSVGChar (tagname))); + XPUSHs (parser); + CALL_VOID; + FINISH; + } +} + +static void +gtk2perl_buildable_custom_finished (GtkBuildable *buildable, + GtkBuilder *builder, + GObject *child, + const gchar *tagname, + gpointer data) +{ + SV * parser = gperl_sv_is_defined ((SV *) data) + ? (SV *) data : &PL_sv_undef; + + GET_METHOD (buildable, "CUSTOM_FINISHED"); + + if (METHOD_EXISTS) { + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + XPUSHs (sv_2mortal (newSVGObject (child))); + XPUSHs (sv_2mortal (newSVGChar (tagname))); + XPUSHs (parser); + CALL_VOID; + FINISH; + } + + if (parser != &PL_sv_undef) + /* No further use for this. */ + SvREFCNT_dec (parser); +} + +static void +gtk2perl_buildable_parser_finished (GtkBuildable *buildable, + GtkBuilder *builder) +{ + GET_METHOD (buildable, "PARSER_FINISHED"); + + if (METHOD_EXISTS) { + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + CALL_VOID; + FINISH; + } +} + +static GObject * +gtk2perl_buildable_get_internal_child (GtkBuildable *buildable, + GtkBuilder *builder, + const gchar *childname) +{ + GObject * child = NULL; + + GET_METHOD (buildable, "GET_INTERNAL_CHILD"); + + if (METHOD_EXISTS) { + SV * sv; + PREP (buildable); + XPUSHs (sv_2mortal (newSVGtkBuilder (builder))); + XPUSHs (sv_2mortal (newSVGChar (childname))); + CALL_SCALAR (sv); + child = SvGObject (sv); + FINISH; + } + + return child; +} + + +static void +gtk2perl_buildable_init (GtkBuildableIface * iface) +{ + iface->set_name = gtk2perl_buildable_set_name; + iface->get_name = gtk2perl_buildable_get_name; + iface->add_child = gtk2perl_buildable_add_child; + iface->set_buildable_property = gtk2perl_buildable_set_buildable_property; + iface->construct_child = gtk2perl_buildable_construct_child; + iface->custom_tag_start = gtk2perl_buildable_custom_tag_start; + iface->custom_tag_end = gtk2perl_buildable_custom_tag_end; + iface->custom_finished = gtk2perl_buildable_custom_finished; + iface->parser_finished = gtk2perl_buildable_parser_finished; + iface->get_internal_child = gtk2perl_buildable_get_internal_child; +} + + + MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable PREFIX = gtk_buildable_ +=for object Gtk2::Buildable - Interface for objects that can be built by Gtk2::Builder +=cut + +=for apidoc __hide__ +=cut +void +_ADD_INTERFACE (class, const char * target_class) + CODE: + { + static const GInterfaceInfo iface_info = { + (GInterfaceInitFunc) gtk2perl_buildable_init, + (GInterfaceFinalizeFunc) NULL, + (gpointer) NULL + }; + GType gtype = gperl_object_type_from_package (target_class); + g_type_add_interface_static (gtype, GTK_TYPE_BUILDABLE, &iface_info); + } + + + +# +# NOTE: The interface methods here really aren't useful in perl code, +# since they are meant to be called by GtkBuilder. I find it +# highly improbable that anyone would want to go to the trouble +# to reimplement GtkBuilder in perl, though i guess it's +# technically possible... Since these were part of the 1.160 +# stable release, they can't be removed. Instead, we'll just +# hide all of them, so we can focus the docs on how to implement +# a buildable, instead of on how to use one. +# + + # These two theoretically collide with Gtk2::Widget::set_name and get_name when # dealing with Gtk2::Widgets. Fortunately though, GtkWidget maps these vfuncs # to gtk_widget_set_name and _get_name anyway. +=for apidoc __hide__ +=cut void gtk_buildable_set_name (GtkBuildable *buildable, const gchar *name); +=for apidoc __hide__ +=cut const gchar * gtk_buildable_get_name (GtkBuildable *buildable); +=for apidoc __hide__ +=cut void gtk_buildable_add_child (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar_ornull *type); # void gtk_buildable_set_buildable_property (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name, const GValue *value); -=for apidoc +=for apidoc __hide__ =for signature $buildable->set_buildable_property ($builder, key => $value, ...) =for arg ... (__hide__) =cut @@ -60,14 +641,439 @@ gtk_buildable_set_buildable_property (Gt } #undef OFFSET -# FIXME: How do we deal with ownership of the returned object? -GObject * gtk_buildable_construct_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name); +# The caller will take ownership of the child. +=for apidoc __hide__ +=cut +GObject_noinc * gtk_buildable_construct_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *name); -# FIXME: Needed? If so, how do we deal with GMarkupParser? +# +# We should not need to expose these, as they are used by GtkBuilder to +# allow the Buildable to handle its own tags during parsing. Unless somebody +# wants to reimplement GtkBuilder in perl code, these won't be useful. +# Besides, the dependency on GMarkupParser is a bit problematic. +# # gboolean gtk_buildable_custom_tag_start (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, GMarkupParser *parser, gpointer *data); # void gtk_buildable_custom_tag_end (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer *data); # void gtk_buildable_custom_finished (GtkBuildable *buildable, GtkBuilder *builder, GObject *child, const gchar *tagname, gpointer data); +=for apidoc __hide__ +=cut void gtk_buildable_parser_finished (GtkBuildable *buildable, GtkBuilder *builder); +=for apidoc __hide__ +=cut GObject * gtk_buildable_get_internal_child (GtkBuildable *buildable, GtkBuilder *builder, const gchar *childname); + + +MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable::ParseContext PREFIX = g_markup_parse_context_ + +# +# NOTE: This is a minimal binding for the parts of GMarkupParseContext +# a user would need from the Buildable custom tag handlers. +# Should GMarkupParseContext be bound in Glib, remove these methods +# and have Gtk2::Builder::ParseContext inherit them from Glib. +# + +=for object Gtk2::Buildable::ParseContext + +=head1 DESCRIPTION + +This object contains context of the XML subset parser used by Gtk2::Builder. +Objects of this type will be passed to the methods invoked on the parser +returned from your Gtk2::Buildable's C. You should use +these methods to create useful error messages, as necessary. + +=cut + +=for see_also Gtk2::Buildable +=cut + +=for apidoc +=for signature string = $parse_context->get_element +Return the name of the currently open element. +=cut +const gchar * g_markup_parse_context_get_element (SV * sv); + C_ARGS: + SvGtkBuildableParseContext (sv) + + +#if GLIB_CHECK_VERSION(2, 15, 0) /* FIXME 2.16 */ + +=for apidoc +=for signature list = $parse_context->get_element_stack +Returns the element stack; the first item is the currently-open tag +(which would be returned by C), and the next item is +its immediate parent. +=cut +void g_markup_parse_context_get_element_stack (SV * sv); + PREINIT: + const GSList * list; + PPCODE: + list = g_markup_parse_context_get_element_stack + (SvGtkBuildableParseContext (sv)); + while (list) { + XPUSHs (sv_2mortal (newSVGChar (list->data))); + list = list->next; + } + +#endif + + +=for apidoc +=for signature (line_number, char_number) = $parse_context->get_position +=cut +void +g_markup_parse_context_get_position (SV * sv) + PREINIT: + int line_number; + int char_number; + PPCODE: + g_markup_parse_context_get_position (SvGtkBuildableParseContext (sv), + &line_number, &char_number); + EXTEND (SP, 2); + PUSHs (sv_2mortal (newSViv (line_number))); + PUSHs (sv_2mortal (newSViv (char_number))); + + +MODULE = Gtk2::Buildable PACKAGE = Gtk2::Buildable + +=for position SYNOPSIS + +=head1 SYNOPSIS + + package Thing; + use Gtk2; + use Glib::Object::Subclass + Glib::Object::, + # The important bit -- add this GInterface to our class + interfaces => [ Gtk2::Buildable:: ], + + # Some signals and properties on the object... + signals => { + exploderize => {}, + }, + properties => [ + Glib::ParamSpec->int ('force', 'Force', + 'Explosive force, in megatons', + 0, 1000000, 5, ['readable', 'writable']), + ], + ; + + sub exploderize { + my $self = shift; + $self->signal_emit ('exploderize'); + } + + # We can accept all defaults for Buildable; see the description + # for details on custom XML. + + package main; + use Gtk2 -init; + my $builder = Gtk2::Builder->new (); + $builder->add_from_string (' + + 50 + + + '); + $builder->connect_signals (); + + my $thing = $builder->get_object ('thing1'); + + $thing->exploderize (); + + sub do_explode { + my $thing = shift; + printf "boom * %d!\n", $thing->get ('force'); + } + + # This program prints "boom * 50!" on stdout. + +=cut + + +=head1 DESCRIPTION + +In order to allow construction from a Gtk2::Builder UI description +(L), +an object must implement the Gtk2::Buildable interface. The interface +includes methods for setting names and properties of objects, parsing +custom tags, and constructing child objects. + +The Gtk2::Buildable interface is implemented by all widgets and many +of the non-widget objects that are provided by GTK+. The main user of +this interface is Gtk2::Builder, so there should be very little need for +applications to call any of the Gtk2::Buildable methods. + +So, instead of focusing on how to call the methods of a Gtk2::Buildable, +this documentation deals with implementing a buildable object. + +=head1 WIDGETS + +Since Gtk2::Widget implements the Gtk2::Buildable interface, all widgets +get buildability gratis. If your widget requires no special markup +syntax to express its configuration, and all properties can be handled +through the standard mechanisms, you can simply add the name of your +perl-derived Glib::Object types to the C tag in the builder UI +description. You don't even have to do anything special in your class +definition. For example, objects of this class: + + package My::Frame; + use Gtk2; + use Glib::Object::Subclass + Gtk2::Frame::, + properties => [ + Glib::ParamSpec->int ('foo', ...), + ], + ; + + ... + + 1; + +could be expressed in a builder definition file like this: + + + 15 + + +Notice that the '::' package separator has been replaced with '__' in the +C attribute; this is because the ':' character is not valid for +GType type names. The mapping from perl package names to GType names should, +in general, be as simple as transliterating the colons. + + +=head1 PLAIN OBJECTS + +Glib::Object does not implement Gtk2::Buildable by itself, so to get a +builder UI file to create your custom Glib::Object subtypes, you'll have +add the Gtk2::Buildable interface to your class's interfaces list. + + package My::Thing; + use Gtk2; # to get Gtk2::Buildable + use Glib::Object::Subclass + Glib::Object::, + interfaces => [ 'Gtk2::Buildable' ], + ... + ; + +Again, if you have no special requirements, then that should be all you need +to do. + +=head1 OVERRIDING BUILDABLE INTERFACE METHODS + +In some cases, you need to override the default Buildable behavior. Maybe +your objects already store their names, or you need some special markup +tags to express configuration. In these cases, add the Gtk2::Buildable +interface to your object declaration, and implement the following methods +as necessary. + +=over + +=item SET_NAME ($self, $name) + +=over + +=item * $name (string) + +=back + +This method should store I<$name> in I<$self> somehow. For example, +Gtk2::Widget maps this to the Gtk2::Widget's C property. If you don't +implement this method, the name will be attached in object data down in C +code. Implement this method if your object has some notion of "name" and +it makes sense to map the XML name attribute to that. + +=item string = GET_NAME ($self) + +If you implement C, you need to implement this method to retrieve +that name. + +=item ADD_CHILD ($self, $builder, $child, $type) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $child (Glib::Object or undef) + +=item * $type (string) + +=back + +C will be called to add I<$child> to I<$self>. I<$type> can be +used to determine the kind of child. For example, Gtk2::Container implements +this method to add a child widget to the container, and Gtk2::Notebook uses +I<$type> to distinguish between "page-label" and normal children. The value +of I<$type> comes directly from the C attribute of the XML C tag. + + +=item SET_BUILDABLE_PROPERTY ($self, $builder, $name, $value) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $name (string) + +=item * $value (scalar) + +=back + +This will be called to set the object property I<$name> on I<$self>, directly +from the C XML tag. It is not normally necessary to implement this +method, as the fallback simply calls C. Gtk2::Window +implements this method to delay showing itself (i.e., setting the "visible" +property) until the whole interface is created. You can also use this to +handle properties that are not wired up through the Glib::Object property +system (though simply creating the property is easier). + + +=item parser or undef = CUSTOM_TAG_START ($self, $builder, $child, $tagname) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $child (Glib::Object or undef) + +=item * $tagname (string) + +=back + +When Gtk2::Builder encounters an unknown tag while parsing the definition +of I<$self>, it will call C to give your code a chance +to do something with it. If I<$tagname> was encountered inside a C +tag, the corresponding object will be passed in I<$child>; otherwise, +I<$child> will be C. + +Your C method should decide whether it supports I<$tagname>. +If not, return C. If you do support it, return a blessed perl object +that implements three special methods to be used to parse that tag. (These +methods are defined by GLib's GMarkupParser, which is a simple SAX-style +setup.) + +=over + +=item START_ELEMENT ($self, $context, $element_name, $attributes) + +=over + +=item * $context (Gtk2::Buildable::ParseContext) + +=item * $element_name (string) + +=item * $attributes (hash reference) Dictionary of all attributes of this tag. + +=back + + +=item TEXT ($self, $context, $text) + +=over + +=item * $context (Gtk2::Buildable::ParseContext) + +=item * $text (string) The text contained in the tag. + +=back + + +=item END_ELEMENT ($self, $context, $element_name) + +=over + +=item * $context (Gtk2::Buildable::ParseContext) + +=item * $element_name (string) + +=back + +=back + +Any blessed perl object that implements these methods is valid as a parser. +(Ain't duck-typing great?) Gtk2::Builder will hang on to this object until +the parsing is complete, and will pass it to C and +C, so you shouldn't have to worry about its lifetime. + + +=item CUSTOM_TAG_END ($self, $builder, $child, $tagname, $parser) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $child (Glib::Object or undef) + +=item * $tagname (string) + +=item * $parser (some perl object) as returned from C + +=back + +This method will be called (if it exists) when the close tag for I<$tagname> +is encountered. I<$parser> will be the object you returned from +C. I<$child> is the same object-or-undef as passed to +C. + + +=item CUSTOM_FINISHED ($self, $builder, $child, $tagname, $parser) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $child (Glib::Object or undef) + +=item * $tagname (string) + +=item * $parser (some perl object) as returned from C + +=back + +This method will be called (if it exists) when the parser finishes dealing +with the custom tag I<$tagname>. I<$parser> will be the object you returned +from C. I<$child> is the same object-or-undef as passed +to C. + + +=item PARSER_FINISHED ($self, $builder) + +=over + +=item * $builder (Gtk2::Builder) + +=back + +If this method exists, it will be invoked when the builder finishes parsing +the description data. This method is handy if you need to defer any object +initialization until all of the rest of the input is parsed, most likely +because you need to refer to an object that is declared after I<$self> or +you need to perform special cleanup actions. It is not normally necessary +to implement this method. + + +=item object or undef = GET_INTERNAL_CHILD ($self, $builder, $childname) + +=over + +=item * $builder (Gtk2::Builder) + +=item * $childname (string) + +=back + +This will be called to fetch an internal child of I<$self>. Implement this +method if your buildable has internal children that need to be accessed from +a UI definition. For example, Gtk2::Dialog implements this to give access +to its internal vbox child. + +=back + +=cut + +=for see_also http://library.gnome.org/devel/gtk/unstable/GtkBuilder.html#BUILDER-UI +=cut + +=for see_also Gtk2::Buildable::ParseContext +=cut