File Coverage

blib/lib/Term/ReadLine/Zoid.pm

Criterion	Covered	Total	%
statement	191	418	45.6
branch	65	214	30.3
condition	23	84	27.3
subroutine	33	61	54.1
pod	25	49	51.0
total	337	826	40.8

package Term::ReadLine::Zoid;

use strict;
use vars '$AUTOLOAD';
use Term::ReadLine::Zoid::Base;
#use encoding 'utf8';
no warnings; # undef == '' down here

our @ISA = qw/Term::ReadLine::Zoid::Base Term::ReadLine::Stub/; # explicitly not use'ing T:RL::Stub
our $VERSION = '0.07';

sub import { # terrible hack - Term::ReadLine in perl 5.6.x is defective
	return unless (caller())[0] eq 'Term::ReadLine' and $] < 5.008 ;
	*Term::ReadLine::Stub::new = sub {
		shift;
		my $self = bless {}, 'Term::ReadLine::Zoid';
		return $self->_init(@_);
	};
}

sub new {
	my $self = bless {}, shift(@_);
	return $self->_init(@_);
}

our $_current;
our %_config  = (
	minline		=> 0,
	autohistory	=> 1,
	autoenv		=> 1,
	autolist	=> 1,
	automultiline	=> 1,
	PS2		=> '> ',
	comment_begin	=> '#',
	maxcomplete	=> 'pager',
	default_mode	=> 'insert',
);
our %_keymaps = (
	insert => {
		return	=> 'accept_line',
		ctrl_O	=> 'operate_and_get_next',
		ctrl_D	=> 'delete_char_or_eof',
		ctrl_C	=> 'return_empty_string',
		escape	=> 'switch_mode_command',
		ctrl_R	=> 'switch_mode_isearch',
		ctrl__	=> 'switch_mode_fbrowse',
		right	=> 'forward_char',
		ctrl_F	=> 'forward_char',
		left	=> 'backward_char',
		ctrl_B	=> 'backward_char',
		home	=> 'beginning_of_line',
		ctrl_A	=> 'beginning_of_line',
		end	=> 'end_of_line',
		ctrl_E	=> 'end_of_line',
		up	=> 'previous_history',
		page_up	=> 'previous_history',
		ctrl_P	=> 'previous_history',
		down	=> 'next_history',
		page_down => 'next_history',
		ctrl_N	=> 'next_history',
		delete	=> 'delete_char',
		backspace => 'backward_delete_char',
		ctrl_U	=> 'unix_line_discard',
		ctrl_K	=> 'kill_line',
		ctrl_W	=> 'unix_word_rubout',
		tab	=> 'complete',
		ctrl_V	=> 'quoted_insert',
		insert	=> 'overwrite_mode',
		ctrl_L	=> 'clear_screen',
		_default => 'self_insert',
	},
	multiline => {
		return	=> 'insert_line',
		up	=> 'backward_line',
		down	=> 'forward_line',
		page_up => 'page_up',
		page_down => 'page_down',
		_isa	=> 'insert',
	},
	command => { _use => 'Term::ReadLine::Zoid::ViCommand'  },
	emacs   => { _use => 'Term::ReadLine::Zoid::Emacs'      },
	emacs_multiline => { _use => 'Term::ReadLine::Zoid::Emacs' },
	fbrowse => { _use => 'Term::ReadLine::Zoid::FileBrowse' },
	isearch => { _use => 'Term::ReadLine::Zoid::ISearch'    },
);

sub _init {
	my ($self, $name, $in, $out) = @_;

	%$self = (
		appname   => $name,
		IN        => $in  || *STDIN{IO},
		OUT       => $out || *STDOUT{IO},
		history   => [],
		hist_cnt  => 1,
		class     => ref($self), # we might be overloaded
		undostack => [],
	%$self );

	$$self{config}{$_}  ||= $_config{$_}  for keys %_config ;
	$$self{keymaps}{$_} ||= $_keymaps{$_} for keys %_keymaps;
	eval "sub switch_mode_$_;" for keys %{$$self{keymaps}}; # if we declare, we can()

	# rcfiles
	my ($rcfile) = grep {-e $_ && -r _}
		"$ENV{HOME}/.perl_rl_zoid_rc",
		"$ENV{HOME}/.zoid/perl_rl_zoid_rc",
		"/etc/perl_rl_zoid_rc";
	if ($rcfile) {
		local $_current = $self;
		do $rcfile;
	}

	# PERL_RL
	if (exists $ENV{PERL_RL}) {
		my ($which, @config) = split /\s+/, $ENV{PERL_RL};
		if (UNIVERSAL::isa($self, "Term::ReadLine::$which")) {
			for (@config) {
				/(\w+)=(.*)/ or next;
				$$self{config}{$1} = $2;
			}
		}
	}

	$self->switch_mode();
	return $self;
}

sub AUTOLOAD {
	$AUTOLOAD =~ s/.*:://;
	return if $AUTOLOAD eq 'DESTROY';
	my $self = shift;
	if ($AUTOLOAD =~ /^switch_mode_(.*)/) {
		$self->switch_mode($1, @_);
	}
	elsif ($$self{class} ne __PACKAGE__) {
		my $sub = $$self{class}.'::'.$AUTOLOAD;
		$self->$sub(@_);
	}
	else {
		my (undef, $f, $l) = caller;
		die "$AUTOLOAD: no such method at $f line $l\n"
	}
}

# ############ #
# ReadLine api #
# ############ #

sub ReadLine { return 'Term::ReadLine::Zoid' }

sub readline {
	my ($self, $prompt, $preput) = @_;
	$self->reset();
	$self->switch_mode();
	$$self{prompt} = defined($prompt) ? $prompt : $$self{appname}.' !> ';
	$$self{lines}  = [ split /\n/, $preput ] if defined $preput;
	my $title = $$self{config}{title} || $$self{appname};
	$self->title($title);
	$self->new_line();
	if ($$self{prev_hist_p}) {
		$self->set_history( delete $$self{prev_hist_p} );
	}
	$self->loop();
	return $self->_return();
}

sub _return { # also used by continue
	my $self = shift;
	bless $self, $$self{class}; # rebless default class
	print { $$self{OUT} } "\n";
	return undef unless defined $$self{_loop}; # exit application
	return '' unless length $$self{_loop}; # return empty string
	my $string = join("\n", @{$$self{lines}}) || '';
	$self->AddHistory($string) if $$self{config}{autohistory};
	return '' if $$self{config}{comment_begin}
		and ! grep {$_ !~ /^\s*\Q$$self{config}{comment_begin}\E/} @{$$self{lines}};
	$string =~ s/\\\n//ge if $$self{config}{automultiline};
	#print STDERR "string: $string\n";
	return $string;
}

sub addhistory {
	my ($self, $line) = @_;
	return unless defined $$self{config}{minline};
	return unless length $line and length($line) > $$self{config}{minline};
	unshift @{$$self{history}}, $line;
	$$self{hist_cnt}++;
}
*AddHistory = \&addhistory; # T:RL:Gnu compat

sub IN { $_[0]{IN} }

sub OUT { $_[0]{OUT} }

sub MinLine {
	my ($self, $minl) = @_;
	my $old_minl = $$self{config}{minline};
	$$self{config}{minline} = $minl;
	return $old_minl;
}

sub Attribs { $_[0]{config} }

sub Features { {
	( map {($_ => 1)} qw/appname minline attribs
		addhistory addHistory getHistory getHistory TermSize/ ),
	( map {($_ => $_[0]{config}{$_})}
		qw/autohistory autoenv automultiline/ ),
} }

# ############ #
# Extended api #
# ############ #

sub GetHistory {
	return wantarray
		? ( reverse @{$_[0]{history}} )
		: [ reverse @{$_[0]{history}} ] ;
}

sub SetHistory {
	my $self = shift;
	$self->{history} = ref($_[0])
		? [ reverse @{$_[0]} ]
		: [ reverse @_       ] ;
}

# TermSize in Base

sub continue { # user typed \n but app says we ain't done
	my $self = shift;
	shift @{$$self{history}} if $$self{history}[0] eq join "\n", @{$$self{lines}};
	$$self{_buffer}++; # previous _return printed a \n
	$self->switch_mode( $$self{mode} ); # switch into last mode
	$self->insert_line();
	$self->loop();
	return $self->_return();
}

sub current {
	return $_current if $_current;
	my (undef, $f, $l) = caller;
	die "No current Term::ReadLine::Zoid object at $f line $l";
}

sub bindkey {
	my ($self, $key, $sub, $mode) = @_;
	$mode ||= $$self{config}{default_mode};
	$$self{keymaps}{$mode} ||= {};
	$key = 'meta_'.uc($1) if $key =~ /^[mM]-(.)$/;
	$key = 'ctrl_'.uc($1) if $key =~ /^(?:\^|[cC]-)(.)$/;
	$sub =~ tr/-/_/ unless ref $sub;
	$$self{keymaps}{$mode}{$key} = $sub;
}

# ######### #
# Render Fu #
# ######### #

sub draw {
	my $self  = shift;
	my @pos   = @{$$self{pos}};   # force copy
	my @lines = @{$$self{lines}}; # idem
#	use Data::Dumper; print STDERR Dumper \@lines, \@pos;

	$pos[0] = length $lines[ $pos[1] ]
		if $pos[0] > length $lines[ $pos[1] ];

	# replace the non printables
	for (0 .. $#lines) {
		if ($_ == $pos[1]) {
			my $start = substr $lines[$_], 0, $pos[0], '';
			my $n = ( $start =~ s{([^[:print:]])}{
				my $ord = ord $1;
				($ord < 32) ? '^'.(chr $ord + 64) : '^?'
			}ge );
			$pos[0] += $n;
			$lines[$_] = $start . $lines[$_];
		}
		$lines[$_] =~ s{([^[:print:]\e])}{
			my $ord = ord $1;
			($ord < 32) ? '^'.(chr $ord + 64) : '^?'
		}ge;
	}

	# format PS1
	my $prompt = ref($$self{prompt}) ? ${$$self{prompt}} : $$self{prompt};
	$prompt =~ s/(!!)|!/$1?'!':$$self{hist_cnt}/eg;

	# format PS2 ... thank carl0s if you like to set nu
	my $len = length scalar @lines;
	my $nu_form = (defined $ENV{CLICOLOR} and ! $ENV{CLICOLOR})
		? "  %${len}u " : "  \e[33m%${len}u\e[0m " ;
	if (@lines > 1) {
		my $ps2 = ref($$self{config}{PS2}) ? ${$$self{config}{PS2}} : $$self{config}{PS2};
		if ($$self{config}{nu}) { # line numbering
			$lines[$_] = sprintf($nu_form, $_ + 1) . $ps2 . $lines[$_]
				for 1 .. $#lines;
			$pos[0] += $self->print_length($ps2) + $len + 3 if $pos[1];
		}
		else {
			$lines[$_] = $ps2 . $lines[$_] for 1 .. $#lines;
			$pos[0] += $self->print_length($ps2) if $pos[1];
		}
	}

	# include PS1
	my @prompt = split /\n/, $prompt, -1;
	if (@prompt) {
		$prompt[-1] = sprintf($nu_form, 1) . $prompt[-1] if $$self{config}{nu};
		$pos[0] += $self->print_length($prompt[-1]) unless $pos[1];
		$pos[1] += $#prompt;
		$lines[0] = pop(@prompt) . $lines[0];
		unshift @lines, @prompt if @prompt;
	}

	# format RPS1
	if (my $rprompt = $$self{config}{RPS1}) {
		$rprompt = $$rprompt if ref $rprompt;
		my $l = $self->print_length($lines[0]);
		if ($rprompt and $l < $$self{term_size}[0]) {
			$rprompt = substr $rprompt, - $$self{term_size}[0] + $l - 1;
			my $w = $$self{term_size}[0] - $l - $self->print_length($rprompt) - 1;
			$lines[0] .= (' 'x$w) . $rprompt;
		}
	}

	$self->print(\@lines, \@pos);
}

*redraw_current_line = \&draw;

# ############ #
# Internal api #
# ############ #

sub switch_mode {
	my ($self, $mode, @args) = @_;
	$mode ||= $$self{config}{default_mode};
	unless ($$self{keymaps}{$mode}) {
		warn "$mode: no such keymap\n\n";
		$mode = 'insert'; # hardcoded fallback
	}
	$$self{mode} = $mode;
	if (my $class = delete $$self{keymaps}{$mode}{_use}) { # bootstrap
		eval "use $class";
		if ($@) {
			$$self{keymaps}{$mode}{_use} = $class; # put it back
			die $@;
		}
		bless $self, $class;
		$$self{keymaps}{$mode} = {
			%{ $$self{keymaps}{$mode} },
			%{ $self->keymap($mode)   }
		} if UNIVERSAL::can($class, 'keymap');
		$$self{keymaps}{$mode}{_class} ||= $class;
	}
	else {
		my $class = $$self{keymaps}{$mode}{_class} || $$self{class};
		#print STDERR "class: $class\n";
		bless $self, $class;
	}

	if (exists $$self{keymaps}{$mode}{_on_switch}) {
		my $sub = $$self{keymaps}{$mode}{_on_switch};
		return ref($sub) ? $sub->($self, @args) : $self->$sub(@args) ;
	}
}

sub reset { # should this go in Base ?
	my $self = shift;
	$$self{lines} = [''];
	$$self{pos}  = [0, 0];
	$$self{_buffer} = 0;
	$$self{replace} = 0;
	$$self{hist_p} = undef;
	$$self{undostack} = [];
	$$self{scroll_pos} = 0;
}

sub save {
	my $self = shift;
	my %save = (
		pos    => [ @{$$self{pos}}   ],
		lines  => [ @{$$self{lines}} ],
		prompt => $$self{prompt},
	);
	return \%save;
}

sub restore {
	my ($self, $save) = @_;
	$$self{pos}    = [ @{$$save{pos}} ];
	$$self{lines}  = [ @{$$save{lines}} ];
	$$self{prompt} = $$save{prompt};
}

sub substring { # buffer is undef is copy, end is undef is insert
	my ($self, $buffer, $start, $end) = @_;

	($start, $end) = sort {$$a[1] <=> $$b[1] or $$a[0] <=> $$b[0]} ($start, $end) if $end;
	my ($pre, $post) = _split($start || $$self{pos}, [ @{$$self{lines}} ]); # force copy of lines
	my $re = [''];
	if ($end) {
		$$end[0] = $$end[0] - $$start[0] if $$end[1] == $$start[1];
		$$end[1] = $$end[1] - $$start[1];
		($re, $post) = _split($end, $post);
	}
	return join "\n", @$re unless defined $buffer;

	$buffer = [split /\n/, $buffer, -1] if ! ref $buffer;
	$buffer = [''] unless @$buffer;
	$$pre[-1] .= shift @$buffer;
	push @$pre, @$buffer;
	$$self{pos} = [ length($$pre[-1]), $#$pre ];
	$$pre[-1] .= shift @$post;
	$$self{lines} = [ @$pre, @$post ];

	return join "\n", @$re;
}

sub _split {
	my ($pos, $buf, $nbuf) = (@_, []);
	push @$nbuf, splice @$buf, 0, $$pos[1] if $$pos[1];
	push @$nbuf, substr($$buf[0], 0, $$pos[0], '') || '';
	return ($nbuf, $buf);
}

# ############ #
# Key routines #
# ############ #

sub previous_history {
	my $self = shift;
	if (not defined $$self{hist_p}) {
		return $self->bell unless scalar @{$$self{history}};
		$$self{_hist_save} = $self->save();
		$self->set_history(0);
	}
	elsif ($$self{hist_p} < $#{$$self{history}}) {
		$self->set_history( ++$$self{hist_p} );
	}
	else { return $self->bell }
	return 1;
}

sub next_history {
	my $self = shift;
	return $self->bell unless defined $$self{hist_p};
	if ($$self{hist_p} == 0) {
		$$self{hist_p} = undef;
		$self->restore($$self{_hist_save});
	}
	else { $self->set_history( --$$self{hist_p} ) }
	return 1;
}

sub set_history {
	my $self = shift;
	my $hist_p = shift;
	return $self->bell if $hist_p < 0 or $$self{hist_p} > $#{$$self{history}};
	$$self{hist_p} = $hist_p;
	$$self{lines} = [ split /\n/, $$self{history}[$hist_p] ];
	$$self{pos} = [ length($$self{lines}[-1]), $#{$$self{lines}} ];
	# posix says {pos} should be [0, 0], i disagree
}

sub self_insert {
	my ($self, $chr) = (@_);

	# force pos on end of line
	$$self{pos}[0] = length $$self{lines}[ $$self{pos}[1] ]
		if $$self{pos}[0] > length $$self{lines}[ $$self{pos}[1] ];

	substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], $$self{replace}, $chr;
	$$self{pos}[0] += length $chr;
}

sub accept_line {
	my $self = shift;
	if (
		$$self{config}{automultiline} and scalar @{$$self{lines}}
		and ! grep /\\\\$|(?
	) {  #print STDERR "funky auto multiline :)\n";
		push @{$$self{lines}}, '';
		$$self{pos} = [0, $#{$$self{lines}}];
	}
	else { $$self{_loop} = 0 }
}

*return = \&accept_line;

sub operate_and_get_next {
	my $self = shift;
	$$self{prev_hist_p} = $$self{hist_p};
	$$self{_loop} = 0;
}

sub return_eof_maybe {
	length( join "\n", @{$_[0]{lines}} )
		? ( $_[0]->bell )
		: ( $_[0]{_loop} = undef ) ;
}

sub return_eof { $_[0]{_loop} = undef }

sub return_empty_string { $_[0]{_loop} = '' }

sub delete_char {
	my $self = shift;

	if ($$self{pos}[0] >= length $$self{lines}[ $$self{pos}[1] ]) {
		$$self{pos}[0] = length $$self{lines}[ $$self{pos}[1] ]; # force pos on end of line
		return $self->bell unless $$self{pos}[1] < @{$$self{lines}};
		$$self{lines}[ $$self{pos}[1] ] .= $$self{lines}[ $$self{pos}[1] + 1 ]; # append next line
		splice @{$$self{lines}}, $$self{pos}[1] + 1, 1; # kill next line
	}
	else { substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], 1, '' }
	return 1;
}

sub delete_char_or_eof {
	my $self = shift;
	if (
		$$self{pos}[1] == $#{$$self{lines}}
		and ! length $$self{lines}[-1]
	) { $$self{_loop} = $$self{pos}[1] ? 0 : undef }
	else { $self->delete_char() }
}

sub backward_delete_char {
	$_[0]->backward_char();
	$_[0]->delete_char() unless $_[0]{replace};
}

sub unix_line_discard {
	$_[0]{killbuf} = join "\n", @{$_[0]{lines}};
	@{$_[0]}{'lines', 'pos'} = ([''], [0, 0])
}

sub possible_completions {
	my $self = shift;
	$self->complete(undef, 'PREVIEW');
}

sub complete {
	my ($self, undef, $preview) = @_;

	# check !autolist stuff
	if ($$self{completions} && @{$$self{completions}}) {
		$self->output( @{$$self{completions}} );
		delete $$self{completions};
		return;
	}

	# get the right function
	my $func = exists($$self{config}{completion_function})
		? $$self{config}{completion_function}
		: $readline::rl_completion_function ;
	return unless $func;
	unless (ref $func) {
		no strict;
		$func = *{$func}{CODE};
		return unless ref $func; # how does this work ?
	}

	# generate the arguments
	my $buffer = join "\n", @{$$self{lines}};
	my $end = $self->pos2off($$self{pos});
	my $word = substr $buffer, 0, $end;
	$word =~ s/^.*\s//s; # only leave /\S*$/
	my $lw = length $word;

	# get the completions and output
	my @compl = $func->($word, $buffer, $end - $lw); # word, line, start
	my $meta = ref($compl[0]) ? shift(@compl) : {} ; # hash constitutes an undocumented feature
	$self->output( $$meta{message} ) if $$meta{message};

	return $self->bell unless @compl;
	if ($compl[0] eq $compl[-1]) { @compl = ($compl[0]) } # 1 item or list with only duplicates
	else { @compl = $self->longest_match(@compl) } # returns $compl, @compl

	# format completion
	my $compl = shift @compl;
	$compl = $$meta{prefix} . $compl;
	$compl .= $$meta{postfix} unless @compl;
	unless ($$meta{quoted}) {
		if ($$meta{quote}) {
			if (ref $$meta{quote}) { $compl = $$meta{quote}->($compl) } # should be code ref
			else { # plain quote
				$compl =~ s#\\\\|(?<=[^\\])($$meta{quote})#$1?"\\$1":'\\\\'#ge if $$meta{quote};
				$compl .= $$meta{quote} if !@compl and $compl =~ /\w$/; # arbitrary cruft
			}
		}
		else { $compl =~ s#\\\\|(?
		$compl .= ' ' if !@compl and $compl =~ /\w$/; # arbitrary cruft
	}

	# display completions
	if (@compl) {
		if ($$self{config}{autolist} || $preview) {
			$self->output( @compl );
			return if $preview;
		}
		else { $$self{completions} = \@compl }
	}

	# update buffer
	push @{$$self{undostack}}, $self->save() if length $compl;
#	print STDERR ">>$buffer<< end $end off: ".($end - $lw)." l: $lw c: $compl\n";
	my $start = $$meta{start} || $end - $lw;
	substr $buffer,  $start, $end - $start, $compl;
	$$self{lines} = [ split /\n/, $buffer ];
	$$self{pos}[0] -= $lw - length($compl); # for the moment completions can't contains \n
}

sub longest_match { # cut doubles and find longest match
	my ($self, @compl) = @_;

	@compl = sort @compl;
	my $match = $compl[0];
	while (length $match and $compl[-1] !~ /^\Q$match\E/) { chop $match } # due to sort only one diff

	my $prev = '';
	return ($match, grep {
		if ($_ eq $prev) { 0 }
		else { $prev = $_; 1 }
	} @compl);
}

sub overwrite_mode {
	my $b = $_[0]{replace};
	$_[0]->switch_mode(); # for command mode
	$_[0]{replace} = $b ? 0 : 1;
}

sub forward_char { # including cnt for vi mode
	my ($self, undef, $cnt) = @_;
	for (1 .. $cnt||1) {
		if ($$self{pos}[0] >= length $$self{lines}[ $$self{pos}[1] ]) {
			return $self->bell unless $$self{pos}[1] < $#{$$self{lines}};
			$$self{pos} = [0, ++$$self{pos}[1]];
		}
		else { $$self{pos}[0]++ }
	}
	return 1;
}

sub backward_char { # including cnt for vi mode
	my ($self, undef, $cnt) = @_;
#	print STDERR "going $cnt left, pos $$self{pos}[0]\n";
	for (1 .. $cnt||1) {
		if ($$self{pos}[0] == 0) {
			return $self->bell if $$self{pos}[1] == 0;
			$$self{pos}[1]--;
			$$self{pos}[0] = length $$self{lines}[ $$self{pos}[1] ];
		}
		elsif ($$self{pos}[0] >= length $$self{lines}[ $$self{pos}[1] ]) {
			$$self{pos}[0] = length($$self{lines}[ $$self{pos}[1] ]) - 1;
		}
		else { $$self{pos}[0]-- }
	}
	return 1;
}

sub beginning_of_line { $_[0]{pos}[0] = 0; return 1 }

sub end_of_line { $_[0]{pos}[0] = length $_[0]{lines}[ $_[0]{pos}[1] ]; return 1 }

sub quoted_insert {
	my $self = shift;
	$self->self_insert($self->read_key);
}

sub unix_word_rubout {
	my $self = shift;
	$$self{pos}[0] = length $$self{lines}[ $$self{pos}[1] ]
		if $$self{pos}[0] > length $$self{lines}[ $$self{pos}[1] ];
	my $pre = substr $$self{lines}[ $$self{pos}[1] ], 0, $$self{pos}[0], '';
	$pre =~ s/\S*\s*$//;
	$$self{pos}[0] = length $pre;
	$$self{lines}[ $$self{pos}[1] ] = $pre . $$self{lines}[ $$self{pos}[1] ];
}

sub kill_line {
	my $self = shift;
	$$self{lines}[ $$self{pos}[1] ] = substr $$self{lines}[ $$self{pos}[1] ], 0, $$self{pos}[0];
}

sub insert_line {
	my $self = shift;
	my $l = length $$self{lines}[ $$self{pos}[1] ];
	my $end = substr $$self{lines}[ $$self{pos}[1] ], $$self{pos}[0], $l, '';
	$$self{pos} = [0, $$self{pos}[1] + 1];
	splice @{$$self{lines}}, $$self{pos}[1], 0, $end || '';
}

sub backward_line {
	my $self = shift;
	return 0 unless $$self{pos}[1] > 0;
	$$self{pos}[1]--;
	return 1;
}

sub forward_line {
	my $self = shift;
	return 0 unless $$self{pos}[1] < $#{$$self{lines}};
	$$self{pos}[1]++;
	return 1;
}

sub page_up {
	my $self = shift;
	my (undef, $higth) = $self->TermSize();
	$$self{pos}[1] -= $higth;
	$$self{pos}[1] = 0 if $$self{pos}[1] < 0;
}


sub page_down {
	my $self = shift;
	my (undef, $higth) = $self->TermSize();
	$$self{pos}[1] += $higth;
	$$self{pos}[1] = $#{$$self{lines}} if $$self{pos}[1] > $#{$$self{lines}};
}

1;

__END__