view release on metacpan or  search on metacpan

lib/PrimaX/InputHistory.pm  view on Meta::CPAN

		, ['Earlier Lines', 'Page Up', kb::PageUp, sub {$_[0]->move_line(-10)}]
		, ['Later Lines', 'Page Down', kb::PageDown, sub {$_[0]->move_line(10)}]
		# Enter runs the line
		, ['Run', 'Return', kb::Return, sub {$_[0]->PressEnter}]
		, ['Run', 'Enter', kb::Enter, sub {$_[0]->PressEnter}]
	);

	return {
		%def,
		pageLines => 10,		# lines to 'scroll' with pageup/pagedown
		accelItems => \@acc,
		outputWidget => ih::StdOut,
		promptFormat => '> ',
		currentLine => 0,
		storeType => ih::All,
	}
}

# This stage initializes the inputline. I believe this is the appropriate stage
# for (1) setting the properties above (2) loading the history file data, and
# (3) connecting to the output widget.
sub init {
	my $self = shift;
	my %profile = $self->SUPER::init(@_);
	foreach ( qw(pageLines promptFormat currentLine outputWidget storeType) ) {
		$self->{$_} = $profile{$_};
	}
	
	# Store the history and revisions:
	$self->currentRevisions([]);
	$self->history([]);
	# history calls currentLine, so this doesn't need to be called:
	# $self->currentLine(0);
	
	# Set up the output widget. Perl scalars with text are not allowed:
	if (not ref($profile{outputWidget}) and $profile{outputWidget} !~ /^\d+$/) {
		croak("Unknown outputWidget $profile{outputWidget}");
	}
	elsif ($profile{outputWidget} == ih::Null) {
		$self->{outputWidget} = new PrimaX::InputHistory::Output::Null;
	}
	elsif ($profile{outputWidget} == ih::StdOut) {
		$self->{outputWidget} = new PrimaX::InputHistory::Output::StdOut;
	}
	else {
		# Make sure it can do what I need:
		use Carp 'croak';
		croak("Unknown outputWidget does not appear to be an object")
			unless ref($profile{outputWidget});
		croak("outputWidget must have methods printout and newline_printout")
			unless $profile{outputWidget}->can('printout')
				and $profile{outputWidget}->can('newline_printout');
		# Add it to self
		$self->{outputWidget} = $profile{outputWidget};
	}

	return %profile;
}

# Changes the contents of the evaluation line to the one stored in the history.
# This is used for the up/down key callbacks for the evaluation line. The
# currentRevisions array holds the revisions to the history, and it is reset
# every time the user runs the evaluation line.
sub move_line {
	my ($self, $requested_move) = @_;
	
	# Set the move to the pageLines number of lines if 10/-10 was requested:
	$requested_move = $self->pageLines if $requested_move == 10;
	$requested_move = -$self->pageLines if $requested_move == -10;
	
	# Determine the requested line number. (currentLine counts backwards)
	my $line_number = $self->currentLine() - $requested_move;
	
	# Don't cycle:
	my $history_length = scalar @{$self->history};
	$line_number = 0 if $line_number < 0;
	$line_number = $history_length if $line_number > $history_length;
	
	# and go there
	$self->currentLine($line_number);
}

# The class properties. Template code for these was taken from Prima::Object's
# name example property code:
sub pageLines {
	return $_[0]->{pageLines} unless $#_;
	$_[0]->{pageLines} = $_[1];
}
sub promptFormat {
	return $_[0]->{promptFormat} unless $#_;
	$_[0]->{promptFormat} = $_[1];
}
sub outputWidget {
	return $_[0]->{outputWidget} unless $#_;
	$_[0]->{outputWidget} = $_[1];
}
sub history {
	return $_[0]->{history} unless $#_;
	$_[0]->{history} = $_[1];
	$_[0]->currentLine(0);
	return $_[1];
}
sub currentRevisions {
	return $_[0]->{currentRevisions} unless $#_;
	$_[0]->{currentRevisions} = $_[1];
}
sub storeType {
	return $_[0]->{storeType} unless $#_;
	$_[0]->{storeType} = $_[1];
}

# Gets or sets the current line number, counting backwards. The current line of
# text is considered to be at 0; the previous entry is 1, etc. This handles all
# the intermediate storage and text swapping.
sub currentLine {
	return $_[0]->{currentLine} unless $#_;
	my ($self, $line_number) = @_;
	
	# Save changes to the current line in the revision list:
	$self->currentRevisions->[$self->{currentLine}] = $self->text;