/usr/local/CPAN/Gtk2-Ex-Geo/Gtk2/Ex/Geo/TreeDumper.pm

• package Gtk2::Ex::Geo::TreeDumper
  • new
  • _do_context_menu
  • _fill_scalar
  • _fill_array
  • _fill_hash
  • _fill_recursive
  • set_data
  • set_title
• EOF

## @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;