~ubuntu-branches/ubuntu/maverick/padre/maverick

package Padre::Wx::Outline;

use 5.008;
use strict;
use warnings;
use Params::Util   ();
use Padre::Wx      ();
use Padre::Current ();
use Padre::Logger;

our $VERSION = '0.63';
our @ISA     = 'Wx::TreeCtrl';

use Class::XSAccessor {
	accessors => {
		force_next => 'force_next',
	}
};

sub new {
	my $class = shift;
	my $main  = shift;
	my $self  = $class->SUPER::new(
		$main->right,
		-1,
		Wx::wxDefaultPosition,
		Wx::wxDefaultSize,
		Wx::wxTR_HIDE_ROOT | Wx::wxTR_SINGLE | Wx::wxTR_HAS_BUTTONS | Wx::wxTR_LINES_AT_ROOT
	);
	$self->SetIndent(10);
	$self->{force_next} = 0;

	Wx::Event::EVT_COMMAND_SET_FOCUS(
		$self, $self,
		sub {
			$self->on_tree_item_set_focus( $_[1] );
		},
	);

	# Double-click a function name
	Wx::Event::EVT_TREE_ITEM_ACTIVATED(
		$self, $self,
		sub {
			$self->on_tree_item_activated( $_[1] );
		}
	);

	$self->Hide;

	$self->{cache} = {};

	return $self;
}

sub right {
	$_[0]->GetParent;
}

sub main {
	$_[0]->GetGrandParent;
}

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

sub clear {
	my ($self) = @_;
	$self->DeleteAllItems;
	return;
}

################################################################
# Cache routines

sub store_in_cache {
	my ( $self, $cache_key, $content ) = @_;

	if ( defined $cache_key ) {
		$self->{cache}->{$cache_key} = $content;
	}
	return;
}

sub get_from_cache {
	my ( $self, $cache_key ) = @_;

	if ( defined $cache_key and exists $self->{cache}->{$cache_key} ) {
		return $self->{cache}->{$cache_key};
	}
	return;
}

#####################################################################
# GUI routines

sub update_data {
	my ( $self, $outline_data, $filename, $right_click_handler ) = @_;

	$self->Freeze;

	# Clear out the existing stuff
	# TO DO extract data for keeping (sub)trees collapsed/expanded (see below)
	#if ( $self->GetCount > 0 ) {
	#	my $r = $self->GetRootItem;
	#	warn ref $r;
	#	use Data::Dumper;
	#	my ( $fc, $cookie ) = $self->GetFirstChild($r);
	#	warn ref $fc;
	#	warn $self->GetItemText($fc) . ': ' . Dumper( $self->GetPlData($fc) );
	#}
	$self->clear;

	require Padre::Wx;

	# If there is no structure, clear the outline pane and return.
	unless ($outline_data) {
		return;
	}

	# Again, slightly differently
	unless (@$outline_data) {
		return 1;
	}

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

	# Update the outline pane
	_update_treectrl( $self, $outline_data, $root );

	# Set MIME type specific event handler
	if ( defined $right_click_handler ) {
		Wx::Event::EVT_TREE_ITEM_RIGHT_CLICK(
			$self,
			$self,
			$right_click_handler,
		);
	}

	# TO DO Expanding all is not acceptable: We need to keep the state
	# (i.e., keep the pragmata subtree collapsed if it was collapsed
	# by the user)
	#$self->ExpandAll;
	$self->GetBestSize;
	$self->Thaw;

	$self->store_in_cache( $filename, [ $outline_data, $right_click_handler ] );

	return 1;
}

sub _update_treectrl {
	my ( $outlinebar, $outline, $root ) = @_;

	foreach my $pkg ( @{$outline} ) {
		my $branch = $outlinebar->AppendItem(
			$root,
			$pkg->{name},
			-1, -1,
			Wx::TreeItemData->new(
				{   line => $pkg->{line},
					name => $pkg->{name},
					type => 'package',
				}
			)
		);
		foreach my $type (qw(pragmata modules attributes methods events)) {
			_add_subtree( $outlinebar, $pkg, $type, $branch );
		}
		$outlinebar->Expand($branch);
	}

	return;
}

sub _add_subtree {
	my ( $self, $pkg, $type, $root ) = @_;

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

	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 = $self->AppendItem(
			$root,
			$type_caption,
			-1,
			-1,
			Wx::TreeItemData->new()
		);

		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) {
			$self->AppendItem(
				$type_elem,
				$item->{name},
				-1, -1,
				Wx::TreeItemData->new(
					{   line => $item->{line},
						name => $item->{name},
						type => $type,
					}
				)
			);
		}
	}
	if ( defined $type_elem ) {
		if ( $type eq 'methods' ) {
			$self->Expand($type_elem);
		} else {
			$self->Collapse($type_elem);
		}
	}

	return;
}

#####################################################################
# Timer Control

sub start {
	my $self = shift; @_ = (); # Feeble attempt to kill Scalars Leaked ($self is leaking)

	# TO DO: GUI on-start initialisation here

	# Set up or reinitialise the timer
	if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
		$self->{timer}->Stop if $self->{timer}->IsRunning;
	} else {
		$self->{timer} = Wx::Timer->new(
			$self,
			Padre::Wx::ID_TIMER_OUTLINE
		);
		Wx::Event::EVT_TIMER(
			$self,
			Padre::Wx::ID_TIMER_OUTLINE,
			sub {
				$self->on_timer( $_[1], $_[2] );
			},
		);
	}
	$self->{timer}->Start(1000);
	$self->on_timer( undef, 1 );

	return ();
}

sub stop {
	my $self = shift;

	TRACE("stopping Outline") if DEBUG;

	# Stop the timer
	if ( Params::Util::_INSTANCE( $self->{timer}, 'Wx::Timer' ) ) {
		$self->{timer}->Stop if $self->{timer}->IsRunning;
	}

	$self->clear;

	# TO DO: GUI on-stop cleanup here

	return ();
}

sub refresh {
	my $self = shift;

	$self->clear;

	my $filename         = Padre::Current->filename;
	my $outline_data_ref = $self->get_from_cache($filename);
	if ( defined $outline_data_ref ) {
		my ( $outline_data, $right_click_handler ) = @$outline_data_ref;
		$self->update_data( $outline_data, $filename, $right_click_handler );
	}

	$self->force_next(1);
}

sub running {
	!!( $_[0]->{timer} and $_[0]->{timer}->IsRunning );
}

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

sub on_tree_item_set_focus {
	my ( $self, $event ) = @_;
	my $main      = Padre::Current->main($self);
	my $page      = $main->current->editor;
	my $selection = $self->GetSelection();
	if ( $selection and $selection->IsOk ) {
		my $item = $self->GetPlData($selection);
		if ( defined $item ) {
			$self->select_line_in_editor( $item->{line} );
		}
	}
	return;
}

sub on_tree_item_activated {
	on_tree_item_set_focus(@_);
	return;
}

sub select_line_in_editor {
	my ( $self, $line_number ) = @_;
	my $main = Padre::Current->main($self);
	my $page = $main->current->editor;
	if (   defined $line_number
		&& ( $line_number =~ /^\d+$/o )
		&& ( defined $page )
		&& ( $line_number <= $page->GetLineCount ) )
	{
		$line_number--;
		$page->EnsureVisible($line_number);
		$page->goto_pos_centerize( $page->GetLineIndentPosition($line_number) );
		$page->SetFocus;
	}
	return;
}

sub on_timer {
	my ( $self, $event, $force ) = @_;

	### NOTE:
	# floating windows, when undocked (err... "floating"), will
	# return Wx::AuiFloatingFrame as their parent. So floating
	# windows should always get their "main" from Padre::Current->main
	# and -not- from $self->main.
	my $main = Padre::Current->main($self);

	my $document = $main->current->document or return;

	unless ( $document->can('get_outline') ) {
		$self->clear;
		return;
	}

	if ( $self->force_next ) {
		$force = 1;
		$self->force_next(0);
	}

	$document->get_outline( force => $force );

	if ( defined($event) ) {
		$event->Skip(0);
	}

	return;
}

1;

# Copyright 2008-2010 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.