view release on metacpan or  search on metacpan

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

   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(
            " "    => "pixbuf",
            "Ref"  => "text",
            "Addr" => "text",
            "Desc" => "text",
         );
         foreach my $ref ( sort_by { $_->name } $sv->$outrefs_mth ) {
            my $strength = $ref->strength;
            push @{ $outrefs->{data} }, [ get_icon( "strength-$strength" ), $ref->name, sprintf( "%#x", $ref->sv->addr ), $ref->sv->desc ];
         }
         $outrefs->signal_connect( row_activated => sub {
            my( $self, $path, $column ) = @_;
            my $data = $self->get_row_data_from_path( $path );

            my $addr = do {
               no warnings 'portable';
               hex $data->[2];
            };
            my $sv = $df->sv_at( $addr );
            history_nav( $sv );
         });
         return vscrollable( $outrefs );
      },
      expand => TRUE,
   );

   Devel::MAT::UI->provides_sv_detail(
      order => 1E6 + 1,
      type => "widget",
      title => "Inrefs",
      render => sub {
         my ( $sv ) = @_;
         my $inrefs = Gtk2::SimpleList->new(
            " "    => "pixbuf",
            "Ref"  => "text",
            "Addr" => "text",
            "Desc" => "text",
         );
         foreach my $ref ( sort_by { $_->name } $sv->$inrefs_mth ) {
            my $strength = $ref->strength;
            if( $ref->sv ) {
               push @{ $inrefs->{data} }, [ get_icon( "strength-$strength" ), $ref->name, sprintf( "%#x", $ref->sv->addr ), $ref->sv->desc ];
            }
            else {
               push @{ $inrefs->{data} }, [ get_icon( "strength-$strength" ), $ref->name, "-", "ROOT" ];
            }
         }
         $inrefs->signal_connect( row_activated => sub {
            my( $self, $path, $column ) = @_;
            my $data = $self->get_row_data_from_path( $path );

            my $addr = hex $data->[2];
            my $sv = $df->sv_at( $addr );
            history_nav( $sv ) if $sv;
         });
         return vscrollable( $inrefs );
      },
      expand => TRUE,
   );
}

### History management
{
   my @back_sv;
   my @forward_sv;
   my $current_sv;

   $backbtn->set_sensitive( FALSE );
   $forwardbtn->set_sensitive( FALSE );

   sub history_back
   {
      return unless @back_sv;

      unshift @forward_sv, $current_sv if $current_sv;
      $current_sv = pop @back_sv;

      $backbtn->set_sensitive( scalar @back_sv );
      $forwardbtn->set_sensitive( scalar @forward_sv );

      display_sv( $current_sv );
   }

   sub history_forward
   {
      return unless @forward_sv;

      push @back_sv, $current_sv if $current_sv;
      $current_sv = shift @forward_sv;

      $backbtn->set_sensitive( scalar @back_sv );
      $forwardbtn->set_sensitive( scalar @forward_sv );

      display_sv( $current_sv );
   }

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

      push @back_sv, $current_sv if $current_sv;
      $current_sv = $sv;

      if( @forward_sv and $sv == $forward_sv[0] ) {
         shift @forward_sv;
      }
      else {
         @forward_sv = ();
      }

      $backbtn->set_sensitive( scalar @back_sv );
      $forwardbtn->set_sensitive( scalar @forward_sv );

      display_sv( $current_sv );
   }

   sub redisplay_sv
   {