view release on metacpan or  search on metacpan

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

 
 my $file_name = 'my_history.txt';
 my $history_length = 10;
 my $inline = PrimaX::InputHistory->create(
     owner => $window,
     text => '',
     pack => {fill => 'both'},
     storeType => ih::NoRepeat,
     onCreate => sub {
         my $self = shift;
         
         # Open the file and set up the history:
         my @history;
         if (-f $file_name) {
             open my $fh, '<', $file_name;
             while (<$fh>) {
                 chomp;
                 push @history, $_;
             }
             close $fh;
         }
         
         # Store the history and revisions:
         $self->history(\@history);
     },
     onDestroy => sub {
         my $self = shift;
         
         # Save the last lines in the history file:
         open my $fh, '>', $file_name;
         # I want to save the *last* N lines, so I don't necessarily start at
         # the first entry in the history:
         my $offset = 0;
         my @history = @{$self->history};
         $offset = @history - $history_length if (@history > $history_length);
         while ($offset < @history) {
             print $fh $history[$offset++], "\n";
         }
         close $fh;
     },
 );
 
 print "Press Up/Down, Page-Up/Page-Down to see your input history\n";
 
 run Prima;


=cut

###########################
# PrimaX::InputHistory #
###########################
# a history-tracking input line.
package PrimaX::InputHistory;
use base 'Prima::InputLine';

# This has the standard profile of an InputLine widget, except that it knows
# about navigation keys and other things useful for the History.
sub profile_default
{
	my %def = %{$_[ 0]-> SUPER::profile_default};

	# These lines are somewhat patterned from the Prima example called 'editor'
	my @acc = (
		# Navigation scrolls through the command history
		  ['Previous Line', 'Up', kb::Up, sub {$_[0]->move_line(-1)}]
		, ['Next Line', 'Down', kb::Down, sub {$_[0]->move_line(1)}]
		# Note that the values of 10 here are purely symbolic; the function
		# actually refers to self's pageLines property when it sees +-10
		, ['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: