view release on metacpan or  search on metacpan

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

	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;
	
	# Get the current character offset:
	my $curr_offset = $self->charOffset;
	# Note the end-of-line position by zero:
	$curr_offset = 0 if $curr_offset == length($self->text);
	
	# make sure the requested line makes sense; cycle if it doesn't, and just
	# set to zero if there is no history:
	my $last_line = scalar @{$self->history};
	if ($last_line) {
		$line_number += $last_line while $line_number < 0;
		$line_number -= $last_line while $line_number > $last_line;
	}
	else {
		$line_number = 0;
	}
	
	# Set self's current line:
	$self->{currentLine} = $line_number;
	
	# Load the text using the Orcish Maneuver:
	my $new_text = $self->currentRevisions->[$line_number]
						//= $self->history->[-$line_number]; #/
	$self->text($new_text);
	
	# Put the cursor at the previous offset. However, if the previous offset
	# was zero, put the cursor at the end of the line:
	$self->charOffset($curr_offset || length($new_text));
	
	return $line_number;
}

# Add a new notification_type for each of on_PressEnter and on_Evaluate. The
# first should be set with hooks that remove or modify any text that needs to be
# cleaned before the eval stage. In other words, if you want to define commands
# that do not parse as a function in Perl, add it as a hook under on_PressEnter.
# The best examples I can think of, which also serve to differentiate between
# the two needs, are NiceSlice processing, and processing the help command. To
# make help work as a bona-fide function, you would have to surround your topic
# with quotes:
#   help 'PDL::IO::FastRaw'
# That's ugly. It would be much nicer to avoid the quotes, if possible, with
# something like this:
#   help PDL::IO::FastRaw
# That's the kinda thing you would handle with an on_PressEnter hook. After the
# help hook handles that sort of thing, it then calls the clear_event() method
# on the InputHistory object. On the other hand, NiceSlice parsing will modify
# the contents of the evaluation, but not call clear_event because it wants the
# contents of the text to be passed to the evaluation.
#
# If the event is properly handled by one of the hooks, the hook should call the
# clear_event() method on this object.
{
	# Keep the notifications hash in its own lexically scoped block so that
	# other's can't mess with it (at least, not without using PadWalker or some
	# such).
	my %notifications = (
		%{Prima::InputLine-> notification_types()},
		PressEnter => nt::Request,
		Evaluate => nt::Action,
		PostEval => nt::Request,
	);
	
	sub notification_types { return \%notifications }
}

# Issues the on_Evaluate notification. The default evaluation is pretty lame -
# it just prints the result of evaling the text using the print command.
sub Evaluate {
	my ($self, $text) = @_;
	$_[0]->notify('Evaluate', $text);
}

sub on_evaluate {
	my ($self, $text) = @_;
	my $results = eval ($text);
	$self->outputWidget->newline_printout($results) if defined $results;
	$self->outputWidget->newline_printout('undef') if not defined $results;
}

# Issues the on_PostEval notification.
sub PostEval {
	$_[0]->notify('PostEval');
}

# The default notification is to do nothing:
sub on_posteval {}