Data-TreeDumper-Renderer-GTK-0.02/000075500000000000000000000000001143473715400165545ustar00rootroot00000000000000Data-TreeDumper-Renderer-GTK-0.02/Changes000075500000000000000000000002571143473715400200560ustar00rootroot00000000000000Revision history for Perl extension Data::TreeDumper::Renderer::GTK. 0.01 Thursday Apr 7 2005 ADDED: The module base on Mup::TreeDumper itself base on an IRC discussion. Data-TreeDumper-Renderer-GTK-0.02/GTK.pm000075500000000000000000000137201143473715400175450ustar00rootroot00000000000000 package Data::TreeDumper::Renderer::GTK ; use 5.006; use strict; use warnings; require Exporter; use AutoLoader qw(AUTOLOAD); our %EXPORT_TAGS = ( 'all' => [ qw() ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw(); our $VERSION = '0.02'; use Data::TreeDumper ; use Gtk2 -init; use Glib ':constants'; use base qw(Gtk2::TreeView Exporter); 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}, $args{dumper_setup}) 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 set_data { my ($self, $data, $dumper_setup) = @_; my $model = Gtk2::TreeStore->new ('Glib::String'); DumpTree ( $data , 'GTK-perl data dump' , %$dumper_setup , RENDERER => { NODE => \&RenderNode # data needed by the renderer , PREVIOUS_LEVEL => 0 , MODEL => $model , PARENT => [Gtk2::TreePath->new_from_string()] } ) ; $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); } } #------------------------------------------------------------------------------------------- sub RenderNode { my ( $element , $level , $is_terminal , $previous_level_separator , $separator , $element_name , $element_value , $td_address , $address_link , $perl_size , $perl_address , $setup ) = @_ ; my $model = $setup->{RENDERER}{MODEL} ; my $parents = $setup->{RENDERER}{PARENT} ; my $previous_level = $setup->{RENDERER}{PREVIOUS_LEVEL} ; # wind up the parents list if necessary splice @$parents, 0, ($previous_level - $level) if($level < $previous_level) ; my $path = $parents->[0] ; my $parent = $model->get_iter($path) if($path->get_depth() > 0) ; $element_value = " = $element_value" if($element_value ne '') ; my $address = $td_address ; $address .= "-> $address_link" if defined $address_link ; $perl_size = "<$perl_size>" if $perl_size ne '' ; my $rendering ; if($setup->{DISPLAY_ADDRESS}) { $rendering = "$element_name$element_value [$address] $perl_size $perl_address" ; } else { $rendering = "$element_name$element_value $perl_size $perl_address" ; } unless($is_terminal) { my $parent = $model->append ($parent); $model->set($parent, 0, $rendering); my $path = $model->get_path($parent) ; unshift @{$setup->{RENDERER}{PARENT}}, $path ; } else { $model->set($model->append($parent),0, $rendering); } $setup->{RENDERER}{PREVIOUS_LEVEL} = $level ; } 1; __END__ =head1 NAME Data::TreeDumper::Renderer::GTK - Gtk2::TreeView renderer for B =head1 SYNOPSIS my $treedumper = Data::TreeDumper::Renderer::GTK->new ( data => \%data, title => 'Test Data', dumper_setup => {DISPLAY_PERL_SIZE => 1} ); $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; my $scroller = Gtk2::ScrolledWindow->new; $scroller->add ($treedumper); $window->add ($scroller); $window->show_all; =head1 HIERARCHY Glib::Object +----Gtk2::Object +----Gtk2::Widget +----Gtk2::Container +----Gtk2::TreeView +----Data::TreeDumper::Renderer::GTK =head1 DESCRIPTION GTK-perl renderer for B. This widget is the gui equivalent of Data::TreeDumper; 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 EXAMPLE B =head1 METHODS =over =item widget = Data::TreeDumper::Renderer::GTK::TreeDumper->new (...) Create a new TreeDumper. The optional arguments are expect to be key/val pairs. =over =item - dumper_setup => hash reference All data is passed to Data::TreeDumper =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 EXPORT None =head1 AUTHORS Khemir Nadim ibn Hamouda. Muppet Copyright (c) 2005 Nadim Ibn Hamouda el Khemir and Muppet. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perlitself. If you find any value in this module, mail me! All hints, tips, flames and wishes are welcome at . =head1 SEE ALSO B for advanced usage of the dumper engine. =cut Data-TreeDumper-Renderer-GTK-0.02/MANIFEST000075500000000000000000000002231143473715400177050ustar00rootroot00000000000000Changes GTK.pm Makefile.PL MANIFEST README test.pl gtk_test.pl Todo META.yml Module meta-data (added by MakeMaker) Data-TreeDumper-Renderer-GTK-0.02/META.yml000064400000000000000000000010701143473715400200230ustar00rootroot00000000000000--- #YAML:1.0 name: Data-TreeDumper-Renderer-GTK version: 0.02 abstract: Gtk2::TreeView renderer for B license: ~ author: - Nadim Khemir generated_by: ExtUtils::MakeMaker version 6.44 distribution_type: module requires: Cairo: 0 Data::TreeDumper: 0.33 Glib: 0 Gtk2: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Data-TreeDumper-Renderer-GTK-0.02/Makefile.PL000075500000000000000000000010171143473715400205300ustar00rootroot00000000000000use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Data::TreeDumper::Renderer::GTK', 'VERSION_FROM' => 'GTK.pm', # finds $VERSION 'PREREQ_PM' => { Glib => 0, Gtk2 => 0, Cairo => 0, Data::TreeDumper => 0.33, }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'GTK.pm', # retrieve abstract from module AUTHOR => 'Nadim Khemir') : ()), ); Data-TreeDumper-Renderer-GTK-0.02/README000075500000000000000000000015331143473715400174410ustar00rootroot00000000000000Data/TreeDumper/Renderer/GTK ============================== Version 0.01 Data::TreeDumper::Renderer::GTK Rendering plug-in for Data::TreeDumper This Gtk2::TreeView derived widget allows you to diplay a Data::TreeDumper generated dump in a GTK window. The nodes are collapsable. In this release: INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Gtk::Perl Data::TreeDumper COPYRIGHT AND LICENCE Copyright (c) 2005 Nadim Ibn Hamouda el Khemir and Muppet. All rights reserved. This program is free software; you can redis- tribute it and/or modify it under the same terms as Perl itself. If you find any value in this module, mail me! All hints, tips, flammes and wishes are welcome at . Data-TreeDumper-Renderer-GTK-0.02/Todo000075500000000000000000000001161143473715400174050ustar00rootroot00000000000000Todo for Data/TreeDumper/Renderer/GTK ====================================== Data-TreeDumper-Renderer-GTK-0.02/gtk_test.pl000075500000000000000000000020771143473715400207460ustar00rootroot00000000000000#!/usr/bin/perl -w use strict; use Glib ':constants'; use Gtk2 -init; use Data::TreeDumper::Renderer::GTK ; # Gtk2::TreeView derived class # 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 = Data::TreeDumper::Renderer::GTK->new ( data => \%data, title => 'Test Data', dumper_setup => {DISPLAY_PERL_SIZE => 1} ); $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, 500); $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; Data-TreeDumper-Renderer-GTK-0.02/test.pl000075500000000000000000000007771143473715400201060ustar00rootroot00000000000000# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test; BEGIN { plan tests => 1 }; use Data::TreeDumper::Renderer::GTK; ok(1); # If we made it this far, we're ok. ######################### # Insert your test code below, the Test module is use()ed here so read # its man page ( perldoc Test ) for help writing this test script.