The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
## @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 Scalar::Util qw(blessed);
use Glib ':constants';
use Gtk2;

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 ($name and $name eq 'buffer =>');
    if (blessed($ref) and $ref->isa('Graph')) {
	_fill_scalar ($self, $model, $parent, $name, 'Graph');
    } elsif (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;