view release on metacpan or  search on metacpan

bin/pmat-explore-gtk  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Carp;

use Glib qw( TRUE FALSE );
use Gtk2 -init;
use Gtk2::SimpleList;

use Devel::MAT;

use List::Util qw( pairs );
use List::UtilsBy qw( sort_by );

use App::Devel::MAT::Explorer::GTK::Resources qw( get_icon );
use App::Devel::MAT::Explorer::GTK::Shell;
use App::Devel::MAT::Explorer::GTK::SVDetail;
use App::Devel::MAT::Explorer::GTK::Utils qw( bytes2size );
use App::Devel::MAT::Explorer::GTK::Widgets qw( framed vscrollable );

my $pmat;
my $df;

my $win = Gtk2::Window->new( "toplevel" );
$win->signal_connect( destroy => sub { Gtk2->main_quit } );
$win->resize( 1000, 600 );
my $winbox = Gtk2::VBox->new( 0, 0 );
$win->add( $winbox );

my $menu = Gtk2::MenuBar->new;
$winbox->pack_start( $menu, FALSE, TRUE, 0 );

my $filemenu = add_submenu( $menu, "File" );
add_menuitem( $filemenu, "Quit" => sub { Gtk2->main_quit } );

my $navmenu = add_submenu( $menu, "Navigate" );

my $toolbar = Gtk2::Toolbar->new;
$toolbar->set_style( 'both' );
$winbox->pack_start( $toolbar, FALSE, TRUE, 0 );

my $backbtn = $toolbar->append_item( "Back", "Go back to the previous SV", "",
   Gtk2::Image->new_from_stock("gtk-go-back", "small-toolbar"), \&history_back );
my $forwardbtn = $toolbar->append_item( "Forward", "Go forward to the next SV", "",
   Gtk2::Image->new_from_stock("gtk-go-forward", "small-toolbar"), \&history_forward );

my $svs_loaded;

my $outrefs_mth = "outrefs";
my $inrefs_mth = "inrefs";
{
   my %mode_buttons;

   my %mode_tooltip = (
      All    => "Display and count every kind of inref and outref",
      Direct => "Display and count only direct inrefs and outrefs",
      Strong => "Display and count only strong direct inrefs and outrefs",
   );

   Devel::MAT::UI->provides_radiobutton_set(
      map {
         my $filter = $_ eq "All" ? "" : "_\L$_";

         Devel::MAT::UI->register_icon(
            name => "refs-$_",
            svg => "icons/refs-$_.svg"
         );

         {
            text    => $_,
            icon    => "refs-$_",
            tooltip => $mode_tooltip{$_},
            code    => sub {
               $outrefs_mth = "outrefs$filter";
               $inrefs_mth  = "inrefs$filter";

               reset_svlist_refs() if $svs_loaded;
               redisplay_sv();
            },
         }
      } qw( All Direct Strong )
   );

   Devel::MAT::UI->provides_sv_detail(
      order => 1E6,
      type => "widget",
      title => "Outrefs",
      render => sub {
         my ( $sv ) = @_;
         my $outrefs = Gtk2::SimpleList->new(

bin/pmat-explore-gtk  view on Meta::CPAN

         5 => scalar $sv->$outrefs_mth,
         6 => scalar $sv->$inrefs_mth,
      );

      $count++;
      progress( sprintf "Loading GTK TreeView %d of %d (%.2f%%)",
         $count, $total, $count*100 / $total ) if ($count % 1000) == 0;
   }

   progress();
}

$bytetotal_label->set_text( $bytes . " bytes" );

my $table = Gtk2::Table->new( 1, 3 );
$hpane->add2( $table );

$svlist_view->signal_connect( row_activated => sub {
   my( $self, $path, $column ) = @_;
   my $iter = $svlist_model->get_iter( $path );
   my $addr = $svlist_model->get( $iter, 1 );

   my $sv = $df->sv_at( $addr );
   history_nav( $sv );
});

$vpane->pack2( App::Devel::MAT::Explorer::GTK::Shell->build_widget( $pmat ), FALSE, TRUE );

progress();

$win->show_all;
Gtk2->main;

sub display_sv
{
   my ( $sv ) = @_;

   $table->remove( $_ ) foreach $table->get_children;
   $table->resize( 1, 1 );

   App::Devel::MAT::Explorer::GTK::SVDetail::display_sv_in_table( $sv, $table );

   $table->show_all;

   for( my $iter = $svlist_model->get_iter_first; $iter; $iter = $svlist_model->iter_next( $iter ) ) {
      my $addr = $svlist_model->get_value( $iter, 1 );

      if( $sv->addr == $addr ) {
         my $path = $svlist_model->get_path( $iter );
         $svlist_view->scroll_to_cell( $path, $svlist_view->get_column( 0 ), '' );
         $svlist_view->get_selection->select_path( $path );
         last;
      }
   }
}

sub add_submenu
{
   my ( $menu, $name ) = @_;

   my $mi = Gtk2::MenuItem->new( $name );
   my $submenu = Gtk2::Menu->new;
   $mi->set_submenu( $submenu );

   $menu->append( $mi );

   return $submenu;
}

sub add_menuitem
{
   my ( $menu, $name, $code ) = @_;

   my $mi = Gtk2::MenuItem->new( $name );
   $mi->signal_connect( activate => $code );

   $menu->append( $mi );
}

sub entry_dialog
{
   my ( $question ) = @_;

   my $d = Gtk2::Dialog->new( $question, $win,
      [ qw( modal destroy-with-parent )],
      'gtk-cancel' => 'reject',
      'gtk-ok'     => 'accept',
   );
   $d->set_default_response( 'accept' );

   my $entry = Gtk2::Entry->new();
   $entry->set_activates_default( TRUE );

   my $vbox = $d->vbox;
   $vbox->pack_start( $entry, 0, 0, 4 );
   $vbox->show_all;

   my $response = $d->run;
   my $text = $entry->get_text;

   $d->destroy;

   return $text if $response eq 'accept';
   return;
}

sub Devel::MAT::UI::provides_radiobutton_set
{
   shift;

   $toolbar->append_space;

   my $group;
   foreach my $button ( @_ ) {
      my $code = $button->{code};

      my $button = $toolbar->append_element(
         "radiobutton", undef, $button->{text}, $button->{tooltip}, "",
         $button->{icon} ? Gtk2::Image->new_from_pixbuf( get_icon( $button->{icon} ) // die "No icon $button->{icon}" ) : undef,
         sub {
            my ( $button ) = @_;
            return unless $button->get_active;

            goto &$code;
         },
      );

      $button->set_group( $group ) if $group;
      $group //= $button->get_group;
   }
}

my %COLTYPES; BEGIN { %COLTYPES = (
   int  => { store_type => "Glib::Int",    renderer => "Gtk2::CellRendererText",   attr => "text"   },