view release on metacpan or  search on metacpan

lib/Gtk2/CV/Plugin/NameCluster.pm  view on Meta::CPAN

      $progress->update (0.5);
      $progress->set_title ("categorize...");

      $cluster->{"000000REMAINING FILES"} = [keys %files];

      # remove component index
      while (my ($k, $v) = each %$cluster) {
         if (exists $groups{substr $k, 6}) {
            my $idx = 0;
            ++$idx while exists $groups{(substr $k, 6) . "/$idx"};
            $k .= "/$idx";
         }
         $groups{substr $k, 6} = $v;
      }

      while (my ($k, $v) = each %groups) {
         delete $groups{$k}
            unless @$v > 1;
      }
   }

   $progress->update (0.75);
   $progress->set_title ("finishing...");

   $self->{cluster} = \%groups;

   @{ $self->{list}{data} } = (
      sort { $b->[0] <=> $a->[0] }
         map [(scalar @{ $groups{$_} }), $_], sort keys %groups
   );
}

sub start {
   my ($self, $schnauzer, $dirview) = @_;

   $self->{schnauzer} = $schnauzer;
   $self->{dirview} = $dirview;

   $self->{signal} = $schnauzer->signal_connect_after (chpaths => sub {
      return if $self->{updating};

      $self->analyse;

      1
   });

   $self->analyse;

   $self->show_all;
}

sub new_schnauzer {
   my ($self, $schnauzer) = @_;

   my $namecluster;

   $schnauzer->signal_connect (popup => sub {
      my ($self, $menu, $cursor, $event) = @_;
      
      $menu->append (my $i_up = new Gtk2::MenuItem "Filename clustering...");
      $i_up->signal_connect (activate => sub {
         $namecluster = Gtk2::CV::Plugin::NameCluster->new;
         $namecluster->start ($self, 0);
      });

      $menu->append (my $i_up = new Gtk2::MenuItem "Subdir view...");
      $i_up->signal_connect (activate => sub {
         $namecluster = Gtk2::CV::Plugin::NameCluster->new;
         $namecluster->start ($self, 1);
      });
   });


   $schnauzer->signal_connect (key_press_event => sub {
      my ($self, $event) = @_;
      my $key = $event->keyval;
      my $state = $event->state;

      $state *= Gtk2::Accelerator->get_default_mod_mask;

      if (
         $state == ["control-mask"]
         && ($key == $Gtk2::Gdk::Keysyms{Up} || $key == $Gtk2::Gdk::Keysyms{Down})
      ) {
         if ($namecluster && $namecluster->{list}) {
            my ($path) = $namecluster->{list}->get_cursor;
            $key == $Gtk2::Gdk::Keysyms{Up} ? $path->prev : $path->next;
            $namecluster->{list}->set_cursor ($path);
         }
         return 1;
      }

      0
   });
}

1