view release on metacpan or  search on metacpan

lib/App/Codit/Plugins/PerlSubs.pm  view on Meta::CPAN

=head1 NAME

App::Codit::Plugins::PerlSubs - plugin for App::Codit

=cut

use strict;
use warnings;
use vars qw( $VERSION );
$VERSION = '0.19';
use base qw( App::Codit::BaseClasses::TextModPlugin );

use Data::Compare;
use Tk;
require Tk::HList;
require Tk::FileBrowser::Header;

=head1 DESCRIPTION

Easily find the subs in your document.

=head1 DETAILS

PerlSubs scans the current selected document for lines that begin
with 'sub someName' and displays it in a list with the line number.
The list is refreshed after an edit.

When you click on and item in the list, the insert cursor is moved to that
line and it is scrolled into visibility.

Both colums are sizable and sortable.

=cut

sub new {
	my $class = shift;
	my $self = $class->SUPER::new(@_);
	return undef unless defined $self;
	
	my $page = $self->ToolLeftPageAdd('PerlSubs', 'code-context', undef, 'Find your Perl subs', 250);

	$self->{CURRENT} = [];
	$self->{SORTON} = 'Line';
	$self->{SORTORDER} = 'ascending';
	
	my $hlist = $page->Scrolled('HList',
		-browsecmd => ['Select', $self],
		-columns => 2,
		-header => 1,
		-scrollbars => 'osoe',
	)->pack(-expand => 1, -fill => 'both');
	$self->{HLIST} = $hlist;
	my $count = 0;
	for ('Sub', 'Line') {
		my $header = $hlist->Header(
			-column => $count,
			-sortcall => ['Sortcall', $self],
			-text => $_,
		);
		$hlist->headerCreate($count,
			-headerbackground => $self->configGet('-background'),
			-itemtype => 'window', 
			-widget => $header
		);
		$count ++;
	}
	my $h2 = $hlist->headerCget(1, '-widget');
	$h2->configure(-sortorder => 'ascending');

	return $self;
}

sub Clear {
	my $self = shift;
	my $hlist = $self->{HLIST};
	$hlist->deleteAll;
}

sub Current {
	my $self = shift;
	$self->{CURRENT} = shift if @_;
	return $self->{CURRENT}
}

sub FillList {
	my ($self, $new, $select) = @_;
	$select = 1 unless defined $select;
	my $hlist = $self->{HLIST};
	my $cursel;
	( $cursel ) = $hlist->infoSelection;
	my $lastvisible = $hlist->nearest($hlist->height - 1);
	$self->Clear;

	for (@$new) {
		my ($name, $num) = @$_;
		my $item = $name;
		my $count = 2;
		while ($hlist->infoExists($item)) {
			$item = "$name$count";
			$count ++
		}
		$hlist->add($item, -data => $num);
		$hlist->itemCreate($item, 0, -text => $name);
		$hlist->itemCreate($item, 1, -text => $num);
	}

	#find and set selection
	if ($select) {
		$hlist->selectionSet($cursel) if (defined $cursel) and $hlist->infoExists($cursel);
		$hlist->see($lastvisible) if (defined $lastvisible) and $hlist->infoExists($lastvisible);
	}
	$self->Current($new);
}

sub Refresh {
	my ($self, $select) = @_;
	$self->SUPER::Refresh;
	$select = 1 unless defined $select;
	my $current = $self->Current;
	my @new = ();