#!/usr/bin/perl -w

use strict;
use Glib ':constants';
use Gtk2 -init;

# some silly test data
my %data = (
	foo => 'bar',
	whee => [ qw(a b c d e f g) ],
	fluffy => {
		a => 'b',
		c => ['foo', [qw(one two three)], {one=>1, two=>2}],
		d => { red => 'blue' },
	},
	'something undefined' => undef,
	'empty array' => [],
	'empty hash' => {},
);


my $treedumper = Mup::TreeDumper->new (data => \%data,
                                       title => 'Test Data');
$treedumper->modify_font
	(Gtk2::Pango::FontDescription->from_string ('monospace'));
$treedumper->expand_all;

# some boilerplate to get the widget onto the screen...
my $window = Gtk2::Window->new;
$window->set_default_size (400, 300);
$window->signal_connect (destroy => sub { Gtk2->main_quit });
my $scroller = Gtk2::ScrolledWindow->new;
$scroller->set_policy ('automatic', 'automatic');
$scroller->set_shadow_type ('in');
$scroller->add ($treedumper);
$window->add ($scroller);
$window->show_all;
Gtk2->main;

package Mup::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;
	$self->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->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 ($model, $parent, $name, $data) = @_;
	my $str = defined ($data) ? "$data" : "[undef]";
	$model->set ($model->append ($parent),
		     0, (defined($name) ? "$name " : ''). $str);
}

sub _fill_array {
	my ($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 ($model, $iter, "[$i] =", $ref->[$i]);
	}
}

sub _fill_hash {
	my ($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 ($model, $iter, "$key =>", $ref->{$key});
	}
}

sub _fill_recursive {
	my ($model, $parent, $name, $ref) = @_;

	if (UNIVERSAL::isa $ref, 'HASH') {
		_fill_hash ($model, $parent, $name, $ref);
	} elsif (UNIVERSAL::isa $ref, 'ARRAY') {
		_fill_array ($model, $parent, $name, $ref);
	} else {
		_fill_scalar ($model, $parent, $name, $ref);
	}
}

sub set_data {
	my ($self, $data) = @_;

	my $model = Gtk2::TreeStore->new ('Glib::String');

	_fill_recursive ($model, undef, undef, $data);

	$self->set_model ($model);
}

sub set_title {
	my ($self, $title) = @_;

	if (defined $title and length $title) {
		$self->get_column (0)->set_title ($title);
		$self->set_headers_visible (TRUE);
	} else {
		$self->set_headers_visible (FALSE);
	}
}

1;

__END__

=head1 NAME

Mup::TreeDumper - Display a deep perl data structure in a TreeView

=head1 SYNOPSIS

  use strict;
  use Glib ':constants';
  use Gtk2 -init;

  # some silly test data.
  my %data = (
      foo => 'bar',
      whee => [ qw(a b c d e f g) ],
      fluffy => {
          a => 'b',
          c => ['foo', [qw(one two three)], {one=>1, two=>2}],
          d => { red => 'blue' },
      },
      'something undefined' => undef,
      'empty array' => [],
      'empty hash' => {},
  );

  my $treedumper = Mup::TreeDumper->new (data => \%data,
                                         title => 'Test Data');
  # start out fully expanded
  $treedumper->expand_all;
  $treedumper->modify_font
          (Gtk2::Pango::FontDescription->from_string ('monospace'));


  # boilerplate to get the widget onscreen...
  my $window = Gtk2::Window->new;
  $window->set_default_size (400, 300);
  $window->signal_connect (destroy => sub { Gtk2->main_quit });
  my $scroller = Gtk2::ScrolledWindow->new;
  $scroller->set_policy ('automatic', 'automatic');
  $scroller->set_shadow_type ('in');
  $window->add ($scroller);
  $scroller->add ($treedumper);
  $window->show_all;
  Gtk2->main;

=head1 HIERARCHY

  Glib::Object
  +----Gtk2::Object
        +----Gtk2::Widget
              +----Gtk2::Container
                    +----Gtk2::TreeView
                          +----Mup::TreeDumper

=head1 DESCRIPTION

This widget is the gui equivalent of Data::Dumper; it will display a
perl data structure in a TreeView, allowing you to fold and unfold child
data structures and get a quick feel for what's where.  Right-clicking
anywhere in the view brings up a context menu, from which the user can
choose to expand or collapse all items.

=head1 METHODS

=over

=item widget = Mup::TreeDumper->new (...)

Create a new TreeDumper.  The optional arguments are expect to be key/val
pairs.

=over

=item - data => scalar

Equivalent to calling C<< $treedumper->set_data ($scalar) >>.

=item - title => string or undef

Equivalent to calling C<< $treedumper->set_title ($string) >>.

=back

=item $treedumper->set_data ($newdata)

=over

=item * $newdata (scalar)

=back

Fill the tree with I<$newdata>, which may be any scalar.  The tree does
not reference I<$newdata> -- necessary data is copied.

=item $treedumper->set_title ($title=undef)

=over

=item * $title (string or undef) a new title

=back

Set the string displayed as the column title.  The view is created with one
column, and the header is visible only if there is a title set.

=back

=head1 AUTHOR

muppet <scott at asofyet dot org>

=cut