## @class Gtk2::Ex::Geo::TreeDumper # @brief The 'inspect' dialog # # From http://www.asofyet.org/muppet/software/gtk2-perl/treedumper.pl-txt package Gtk2::Ex::Geo::TreeDumper; use strict; use Gtk2; use Glib ':constants'; use base 'Gtk2::TreeView'; sub new { my $class = shift; my %args = (data => undef, @_); #my $self = bless Gtk2::TreeView->new, $class; my $self = bless {}, $class; $self->{tree_view} = bless Gtk2::TreeView->new, $class; $self->{tree_view}->insert_column_with_attributes (0, 'Data', Gtk2::CellRendererText->new, text => 0); $self->set_data ($args{data}) if exists $args{data}; $self->set_title ($args{title}); $self->{tree_view}->signal_connect (button_press_event => sub { my ($widget, $event) = @_; if ($event->button == 3) { _do_context_menu ($widget, $event); return TRUE; } return FALSE; }); return $self; } sub _do_context_menu { my ($self, $event) = @_; my $menu = Gtk2::Menu->new; foreach my $method ('expand_all', 'collapse_all') { my $label = join ' ', map { ucfirst $_ } split /_/, $method; my $item = Gtk2::MenuItem->new ($label); $menu->append ($item); $item->show; $item->signal_connect (activate => sub { $self->$method; }); } $menu->popup (undef, undef, undef, undef, $event->button, $event->time); } sub _fill_scalar { my ($self, $model, $parent, $name, $data) = @_; my $str = defined ($data) ? "$data" : "[undef]"; $model->set ($model->append ($parent), 0, (defined($name) ? "$name " : ''). $str); } sub _fill_array { my ($self, $model, $parent, $name, $ref) = @_; my $iter = $model->append ($parent); my $refstr = "$ref" . (@$ref ? '' : ' [empty]'); $model->set ($iter, 0, defined($name) ? "$name $refstr" : "$refstr"); for (my $i = 0; $i < @$ref; $i++) { _fill_recursive ($self, $model, $iter, "[$i] =", $ref->[$i]); } } sub _fill_hash { my ($self, $model, $parent, $name, $ref) = @_; my $iter = $model->append ($parent); my $refstr = "$ref" . (%$ref ? '' : ' [empty]'); $model->set ($iter, 0, defined($name) ? "$name $refstr" : "$refstr"); foreach my $key (sort keys %$ref) { _fill_recursive ($self, $model, $iter, "$key =>", $ref->{$key}); } } sub _fill_recursive { my ($self, $model, $parent, $name, $ref) = @_; return if $self->{data}{$ref}; $self->{data}{$ref} = 1; if (UNIVERSAL::isa $ref, 'HASH') { _fill_hash ($self, $model, $parent, $name, $ref); } elsif (UNIVERSAL::isa $ref, 'ARRAY') { _fill_array ($self, $model, $parent, $name, $ref); } else { _fill_scalar ($self, $model, $parent, $name, $ref); } } sub set_data { my ($self, $data) = @_; my $model = Gtk2::TreeStore->new ('Glib::String'); _fill_recursive ($self, $model, undef, undef, $data); $self->{tree_view}->set_model ($model); } sub set_title { my ($self, $title) = @_; if (defined $title and length $title) { $self->{tree_view}->get_column (0)->set_title ($title); $self->{tree_view}->set_headers_visible (TRUE); } else { $self->{tree_view}->set_headers_visible (FALSE); } } 1;