The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Padre::Wx::Outline;

use 5.010;
use strict;
use warnings;
use Scalar::Util             ();
use Params::Util             ();
use Padre::Feature           ();
use Padre::Role::Task        ();
use Padre::Wx                ();
use Padre::Wx::Role::Idle    ();
use Padre::Wx::Role::View    ();
use Padre::Wx::Role::Main    ();
use Padre::Wx::Role::Context ();
use Padre::Wx::FBP::Outline  ();
use Padre::Logger;

our $VERSION = '1.00';
our @ISA     = qw{
	Padre::Role::Task
	Padre::Wx::Role::Idle
	Padre::Wx::Role::View
	Padre::Wx::Role::Main
	Padre::Wx::Role::Context
	Padre::Wx::FBP::Outline
};


######################################################################
# Constructor and Accessors

sub new {
	my $class = shift;
	my $main  = shift;
	my $panel = shift || $main->right;
	my $self  = $class->SUPER::new($panel);

	# This tool is just a single tree control
	my $tree = $self->{tree};
	$self->disable;
	$tree->SetIndent(10);

	# Prepare the available images
	my $images = Wx::ImageList->new( 16, 16 );
	$self->{images} = {
		folder => $images->Add(
			Wx::ArtProvider::GetBitmap(
				'wxART_FOLDER',
				'wxART_OTHER_C',
				[ 16, 16 ],
			),
		),
		file => $images->Add(
			Wx::ArtProvider::GetBitmap(
				'wxART_NORMAL_FILE',
				'wxART_OTHER_C',
				[ 16, 16 ],
			),
		),
	};
	$tree->AssignImageList($images);

	# Binding for the idle time tree activation
	Wx::Event::EVT_TREE_ITEM_ACTIVATED(
		$self,
		$self->{tree},
		sub {
			$_[0]->idle_method( item_activated => $_[1]->GetItem );
		},
	);

	Wx::Event::EVT_TEXT(
		$self,
		$self->{search},
		sub {
			$self->render;
		},
	);

	# Handle char events in search box
	Wx::Event::EVT_CHAR(
		$self->{search},
		sub {
			my ( $this, $event ) = @_;

			my $code = $event->GetKeyCode;
			if ( $code == Wx::K_DOWN or $code == Wx::K_UP or $code == Wx::K_RETURN ) {

				# Up/Down and return keys focus on the functions lists
				my $tree = $self->{tree};
				$tree->SetFocus;
				my $selection = $tree->GetSelection;
				if ( $selection == -1 and $tree->GetCount > 0 ) {
					$selection = 0;
				}
				$tree->SelectItem($selection);
			} elsif ( $code == Wx::K_ESCAPE ) {

				# Escape key clears search and returns focus
				# to the editor
				$self->{search}->SetValue('');
				$self->main->editor_focus;
			}

			$event->Skip(1);
			return;
		}
	);

	$self->context_bind;

	if (Padre::Feature::STYLE_GUI) {
		$self->main->theme->apply($self);
	}

	return $self;
}


#####################################################################
# Event Handlers

sub on_tree_item_right_click {
	my $self  = shift;
	my $event = shift;
	my $tree  = $self->{tree};
	my $item  = $event->GetItem or return;
	my $data  = $tree->GetPlData($item) or return;
	my $show  = 0;
	my $menu  = Wx::Menu->new;

	if ( defined $data->{line} and $data->{line} > 0 ) {
		my $goto = $menu->Append( -1, Wx::gettext('&Go to Element') );
		Wx::Event::EVT_MENU(
			$self, $goto,
			sub {
				$self->item_activated($item);
			},
		);
		$show++;
	}

	if ( defined $data->{type} and $data->{type} =~ /^(?:modules|pragmata)$/ ) {
		my $pod = $menu->Append( -1, Wx::gettext('Open &Documentation') );
		Wx::Event::EVT_MENU(
			$self, $pod,
			sub {

				# TO DO Fix this wasting of objects (cf. Padre::Wx::Menu::Help)
				require Padre::Wx::Browser;
				my $help = Padre::Wx::Browser->new;
				$help->help( $data->{name} );
				$help->SetFocus;
				$help->Show(1);
				return;
			},
		);
		$show++;
	}

	if ( $show > 0 ) {
		my $x = $event->GetPoint->x;
		my $y = $event->GetPoint->y;
		$tree->PopupMenu( $menu, $x, $y );
	}

	return;
}


######################################################################
# Padre::Wx::Role::Context Methods

sub context_menu {
	my $self = shift;
	my $menu = shift;
	$self->context_append_options( $menu => 'main_outline_panel' );
}


######################################################################
# Padre::Wx::Role::View Methods

sub view_panel {
	return 'right';
}

sub view_label {
	Wx::gettext('Outline');
}

sub view_close {
	$_[0]->main->show_outline(0);
}

sub view_stop {
	$_[0]->task_reset;
}


######################################################################
# Padre::Role::Task Methods

sub task_finish {
	TRACE( $_[1] ) if DEBUG;
	my $self = shift;
	my $task = shift;
	my $data = Params::Util::_ARRAY( $task->{data} ) or return;
	my $lock = $self->lock_update;

	# Cache data model for faster searches
	$self->{data} = $data;

	# And render it
	$self->render;

	return 1;
}

sub render {
	my $self = shift;
	my $data = $self->{data};
	my $term = quotemeta $self->{search}->GetValue;
	my $lock = Wx::WindowUpdateLocker->new( $self->{tree} );

	# Clear any old content
	$self->clear;

	# Add the hidden unused root
	my $tree   = $self->{tree};
	my $images = $self->{images};
	my $root   = $tree->AddRoot(
		Wx::gettext('Outline'),
		-1,
		-1,
		Wx::TreeItemData->new('')
	);

	# Add the package trees
	foreach my $pkg (@$data) {
		my $branch = $tree->AppendItem(
			$root,
			$pkg->{name},
			-1, -1,
			Wx::TreeItemData->new(
				{   line => $pkg->{line},
					name => $pkg->{name},
					type => 'package',
				}
			)
		);
		$tree->SetItemImage( $branch, $images->{folder} );

		my @types = qw(classes grammars packages pragmata modules
			attributes methods events roles regexes);
		foreach my $type (@types) {
			$self->add_subtree( $pkg, $type, $branch );
		}
		$tree->Expand($branch);
	}

	# Set MIME type specific event handler
	Wx::Event::EVT_TREE_ITEM_RIGHT_CLICK(
		$tree, $tree,
		sub {
			$self->on_tree_item_right_click( $_[1] );
		},
	);

	$self->GetBestSize;

	return;
}


######################################################################
# General Methods

sub item_activated {
	my $self = shift;
	my $item = shift or return;
	my $tree = $self->{tree};
	my $data = $tree->GetPlData($item) or return;
	my $line = $data->{line} or return;
	$self->select_line_in_editor($line);
}

# Sets the focus on the search field
sub focus_on_search {
	$_[0]->{search}->SetFocus;
}

sub clear {
	$_[0]->{tree}->DeleteAllItems;
}

sub refresh {
	TRACE( $_[0] ) if DEBUG;
	my $self     = shift;
	my $current  = shift or return;
	my $document = $current->document;
	my $lock     = $self->lock_update;
	my $tree     = $self->{tree};

	# Cancel any existing outline task
	$self->task_reset;

	# Hide the widgets when no files are open
	unless ($document) {
		$self->disable;
		return;
	}

	# Is there an outline task for this document type
	my $task = $document->task_outline;
	unless ($task) {
		$self->disable;
		return;
	}

	# Shortcut if there is nothing to search for
	if ( $document->is_unused ) {
		$self->disable;
		return;
	}

	# Ensure the search box and tree are visible
	$self->enable;

	# Trigger the task to fetch the refresh data
	$self->task_request(
		task     => $task,
		document => $document,
	);
}

sub disable {
	my $self = shift;
	$self->{search}->Hide;
	$self->{tree}->Hide;
	$self->clear;
}

sub enable {
	my $self = shift;

	$self->{search}->Show;
	$self->{tree}->Show;

	# Recalculate our layout in case the view geometry
	# has changed from when we were hidden.
	$self->Layout;
}

sub add_subtree {
	my ( $self, $pkg, $type, $root ) = @_;
	my $tree   = $self->{tree};
	my $term   = quotemeta $self->{search}->GetValue;
	my $images = $self->{images};

	my %type_caption = (
		pragmata   => Wx::gettext('Pragmata'),
		modules    => Wx::gettext('Modules'),
		methods    => Wx::gettext('Methods'),
		attributes => Wx::gettext('Attributes'),
	);

	my $type_elem = undef;
	if ( defined( $pkg->{$type} ) && scalar( @{ $pkg->{$type} } ) > 0 ) {
		my $type_caption = ucfirst($type);
		if ( exists $type_caption{$type} ) {
			$type_caption = $type_caption{$type};
		} else {
			warn "Type not translated: $type_caption\n";
		}

		$type_elem = $tree->AppendItem(
			$root,
			$type_caption,
			-1,
			-1,
			Wx::TreeItemData->new
		);
		$tree->SetItemImage( $type_elem, $images->{folder} );

		my @sorted_entries = ();
		if ( $type eq 'methods' ) {
			my $config = $self->main->{ide}->config;
			if ( $config->main_functions_order eq 'original' ) {

				# That should be the one we got
				@sorted_entries = @{ $pkg->{$type} };
			} elsif ( $config->main_functions_order eq 'alphabetical_private_last' ) {

				# ~ comes after \w
				my @pre = map { $_->{name} =~ s/^_/~/; $_ } @{ $pkg->{$type} };
				@pre = sort { $a->{name} cmp $b->{name} } @pre;
				@sorted_entries = map { $_->{name} =~ s/^~/_/; $_ } @pre;
			} else {

				# Alphabetical (aka 'abc')
				@sorted_entries = sort { $a->{name} cmp $b->{name} } @{ $pkg->{$type} };
			}
		} else {
			@sorted_entries = sort { $a->{name} cmp $b->{name} } @{ $pkg->{$type} };
		}

		foreach my $item (@sorted_entries) {
			my $name = $item->{name};

			#ToDo hack to remove double spacing caused by a stray has with no value, works with PPIx 0.15_02 but overwites
			$name =~ s/\n//;

			next if $name !~ /$term/;
			my $item = $tree->AppendItem(
				$type_elem,
				$name, -1, -1,
				Wx::TreeItemData->new(
					{   line => $item->{line},
						name => $name,
						type => $type,
					}
				)
			);
			$tree->SetItemImage( $item, $images->{file} );
		}
	}
	if ( defined $type_elem ) {
		if ( length $term > 0 ) {
			$tree->Expand($type_elem);
		} else {
			if ( $type eq 'methods' ) {
				$tree->Expand($type_elem);
			} elsif ( $type eq 'attributes' ) {
				$tree->Expand($type_elem);
			} else {
				if ( $tree->IsExpanded($type_elem) ) {
					$tree->Collapse($type_elem);
				}
			}
		}
	}

	return;
}

sub select_line_in_editor {
	my $self   = shift;
	my $line   = shift;
	my $editor = $self->current->editor or return;
	if (   defined $line
		&& ( $line =~ /^\d+$/o )
		&& ( $line <= $editor->GetLineCount ) )
	{
		$line--;
		$editor->goto_line_centerize($line);
	}
	return;
}

1;

# Copyright 2008-2013 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.