Gtk3 and subclassing

[Jeff <jffry posteo net>]

Whilst working up a smallest working example for another bug, I've
discovered that I cannot get subclassing working when the main package
is in the same file as the module.

Below is the Gtk2 subclassing example from Muppet which I have trivially
converted to Gtk3.

I get the following error messages:

Odd number of elements in anonymous hash at
/usr/lib/x86_64-linux-gnu/perl5/5.28/Glib/Object/Introspection.pm line 267.
*** unhandled exception in callback:
***   Can't locate object method "get_colormap" via package
"Gtk3::EventBox" at ../gtk3-subclass.pl line 93.
***  ignoring at
/usr/lib/x86_64-linux-gnu/perl5/5.28/Glib/Object/Introspection.pm line 67.

What is going on?

Regards

Jeff

#http://gtk2-perl.sourceforge.net/doc/subclassing_widgets_in_perl.html
#!/usr/bin/perl -w

use strict;

package Mup::ColorButton;

use Gtk3;

# this big hairy statement registers our Glib::Object-derived class
# and sets up all the signals and properties for it.
use Glib::Object::Subclass Gtk3::Button::, signals => {
        # with an empty hash for color_changed, we use all defaults,
        # which results in a signal which receives no extra parameters[2]
        # and returns no value.
        color_changed => {},
        # by supplying a subroutine reference for an existing signal,
        # we override the default handler for the class; this is how
        # you override virtual functions on Glib::Objects.
        show => \&on_show,
    },
    properties => [
        Glib::ParamSpec->int (
                'red', # name
                'Red', # nickname
                'The Red component of the RGB color', #blurb
                0, # min
                0xffff, # max
                0xffff, # default
                [qw/readable writable/] #flags
        ),
        Glib::ParamSpec->int (
                'green', 'Green', 'The Green component of the RGB color',
                0, 0xffff, 0xffff, [qw/readable writable/]
        ),
        Glib::ParamSpec->int (
                'blue', 'Blue', 'The Blue component of the RGB color',
                0, 0xffff, 0xffff, [qw/readable writable/]
        ),
    ];

# as part of creating the C object, Glib will call the INIT_INSTANCE
# method to, surprise, initialize the instance.  this is not an inherited
# method; it will be called with a fully-qualified package name.
# most of what we used to have in the constructor goes here.
# in fact, we just inherit new() from the base class, because it does
# everything we need it to.
sub INIT_INSTANCE {
        my $self = shift;
        $self->{red} = 0xffff;
        $self->{green} = 0xffff;
        $self->{blue} = 0xffff;
        my $frame = Gtk3::Frame->new;
        $frame->set_border_width (3);
        $frame->set_shadow_type ('etched-in');
        $self->add ($frame);
        $frame->show;
        my $event_box = Gtk3::EventBox->new;
        $event_box->set_size_request (14, 14);
        $frame->add ($event_box);
        $event_box->show;
        $self->{colorbox} = $event_box;
}

# in a more ambitious widget, we'd probably define GET_PROPERTY
# and SET_PROPERTY to do some custom stuff... for our purposes,
# however, the default implementation provided by Glib::Object::Subclass
# is sufficient.  (it sets the property values as hash members in the
# instance variable.)

# here we need to override the show method to set the color the
# first time we go onscreen, because we can't do that in the
# initializer (the GdkWindow does not exist yet).
sub on_show {
        my $self = shift;
        $self->set_color (red => $self->{red},
                          green => $self->{green},
                          blue => $self->{blue});
        # perl code that needs to call the parent class usually does
something
        # like  $self->SUPER::methodname ---- however, class_closures for
        # for Glib::Objects are not inheritable in that way; the code to
which
        # we need to chain may not even be perl code.  Glib provides this
        # method to provide that functionality, instead.
        $self->signal_chain_from_overridden;
}

sub set_color {
        my $self = shift;
        my %params = @_;
        my $color = Gtk3::Gdk::Color->new ($params{red},
                                           $params{green},
                                           $params{blue});
        $self->{colorbox}->get_colormap->alloc_color ($color, 0, 1);
        $self->{colorbox}->modify_bg ('normal', $color);
        $self->{colorbox}->modify_bg ('active', $color);
        $self->{colorbox}->modify_bg ('prelight', $color);
        $self->{red} = $params{red};
        $self->{green} = $params{green};
        $self->{blue} = $params{blue};
        # emit the color-changed signal.  note again that the signal
        # name treats - and _ as equivalent.
        $self->signal_emit ('color-changed');
}

package main;

use Gtk3 -init;

my $window = Gtk3::Window->new;
$window->set_title ('Color buttons');
$window->set_border_width (6);
$window->signal_connect (delete_event => sub { Gtk3->main_quit; 1 });

my $vbox = Gtk3::VBox->new;
$window->add ($vbox);
$vbox->show;

my $foo = Mup::ColorButton->new (red => 0xaaaa, green => 0x0, blue =>
0xffff);
$vbox->pack_start ($foo, 1, 1, 0);
$foo->show;

$foo->signal_connect (clicked => sub {
                my $self = shift;
                my $dialog = Gtk3::ColorSelectionDialog->new ('pick a
color');
                my $c = Gtk3::Gdk::Color->new ($self->{red},
                                               $self->{green},
                                               $self->{blue});
                $self->{colorbox}->get_colormap->alloc_color ($c, 0, 1);
                $dialog->colorsel->set_current_color ($c);
                if ('ok' eq $dialog->run) {
                        my $c = $dialog->colorsel->get_current_color;
                        $self->set_color (red => $c->red,
                                          green => $c->green,
                                          blue => $c->blue);
                }
                $dialog->destroy;
        });

$foo->signal_connect (color_changed => sub {
        warn "the color changed - now "
           . join (", ", $_[0]->get (qw/red green blue/))
           . ".  i should do something!";
     });

$window->show;
Gtk3->main;

Attachment: signature.asc
Description: OpenPGP digital signature