File Coverage

blib/lib/Term/ReadLine/Simple.pm

Criterion	Covered	Total	%
statement	81	538	15.0
branch	18	284	6.3
condition	2	84	2.3
subroutine	26	46	56.5
pod	4	12	33.3
total	131	964	13.5

package Term::ReadLine::Simple;

use warnings;
use strict;
use 5.008003;

our $VERSION = '0.308';

use Carp       qw( croak carp );
use Encode     qw( encode );
use List::Util qw( any );

use Encode::Locale    qw();
use Text::LineFold    qw();
use Unicode::GCString qw();

use Term::ReadLine::Simple::Constants qw( :rl );

my $Plugin_Package;

BEGIN {
    if ( $^O eq 'MSWin32' ) {
        require Term::ReadLine::Simple::Win32;
        $Plugin_Package = 'Term::ReadLine::Simple::Win32';
    }
    else {
        require Term::ReadLine::Simple::Linux;
        $Plugin_Package = 'Term::ReadLine::Simple::Linux';
    }
}

sub ReadLine { 'Term::ReadLine::Simple' }
sub IN {}
sub OUT {}
sub MinLine {}
sub Attribs { {} }
sub Features { { no_features => 1 } }
sub addhistory {}
sub ornaments {}


sub new {
    my $class = shift;
    my ( $name ) = @_;
    my $self = bless {
        name => $name,
    }, $class;
    $self->__set_defaults();
    $self->{plugin} = $Plugin_Package->new();
    return $self;
}


sub DESTROY {
    my ( $self ) = @_;
    $self->__reset_term();
}


sub __set_defaults {
    my ( $self ) = @_;
    # compat         : undef ok
    # reinit_encoding: undef ok
    # no_echo        : false ok
    $self->{default} = '';

    # prompt   : undef ok
    # mark_curr: false ok
    # back     : undef ok
    $self->{auto_up} = 0;
    $self->{back}    = '';
    $self->{confirm} = '<<';
    $self->{ro}      = [];
}


sub __validate_options {
    my ( $self, $opt, $valid ) = @_;
    if ( ! defined $opt ) {
        $opt = {};
        return;
    }
    my $sub =  ( caller( 1 ) )[3];
    $sub =~ s/^.+::([^:]+)\z/$1/;

####
    if ( exists $opt->{sep} && ! $self->{called_sep_message} && $sub ne 'readline' ) {      # remove
        print "  '$sub' called with the option 'sep'.\n";
        print "  The option 'sep' has been removed.\n";
        print "  Write an email to cuer2s\x{0040}gmail.com with the subject\n";
        print "  'keep opt sep' if you want back the option 'sep'.\n";
        print "  Press ENTER to continue: ";
        ;
        $self->{called_sep_message} = 1;
    }
####

    for my $key ( keys %$opt ) {
        if ( ! exists $valid->{$key} ) {
            croak $sub . ": '$key' is not a valid option name";
        }
        if ( ! defined $opt->{$key} ) {
            next;
        }
        if ( ref $opt->{$key} ) {
            if ( $valid->{$key} eq 'ARRAY' ) {
                next;
            }
            croak $sub . ": option '$key' : a reference is not a valid value.";
        }
        if (  $valid->{$key} eq '' ) {
            next;
        }
        if ( $opt->{$key} !~ m/^$valid->{$key}\z/x ) {
            croak $sub . ": option '$key' : '$opt->{$key}' is not a valid value.";
        }
    }
}


sub __init_term {
    my ( $self ) = @_;
    $self->{plugin}->__set_mode();
    if ( $self->{reinit_encoding} ) {
        Encode::Locale::reinit( $self->{reinit_encoding} );
    }
}


sub __reset_term {
    my ( $self ) = @_;
    delete $self->{enter_row} if exists $self->{enter_row};
    delete $self->{enter_col} if exists $self->{enter_col};
    if ( defined $self->{plugin} ) {
        $self->{plugin}->__reset_mode();
    }
}


sub config {
    my ( $self, $opt ) = @_;
    if ( defined $opt ) {
        if ( ref $opt ne 'HASH' ) {
            croak "config: the (optional) argument must be a HASH reference";
        }
        my $valid = {
            no_echo         => '[ 0 1 2 ]',
            compat          => '[ 0 1 ]',
            reinit_encoding => '',
            default         => '',
            prompt          => '',
            back            => '',
            confirm         => '',
            auto_up         => '[ 0 1 2 ]',
            mark_curr       => '[ 0 1 ]',
            ro              => 'ARRAY',
####
            sep             => '', # remove
####
        };
        $self->__validate_options( $opt, $valid );
        for my $option ( keys %$opt ) {
            $self->{$option} = $opt->{$option};
        }
    }
}


sub readline {
    my ( $self, $prompt, $opt ) = @_;
    if ( defined $prompt ) {
        croak "readline: a reference is not a valid prompt." if ref $prompt;
    }
    else {
        $prompt = '';
    }
    if ( defined $opt ) {
        if ( ! ref $opt ) {
            $opt = { default => $opt };
        }
        elsif ( ref $opt ne 'HASH' ) {
            croak "readline: the (optional) second argument must be a string or a HASH reference";
        }
    }
    my $valid = {
        no_echo => '[ 0 1 2 ]',
        default => '',
    };
    $self->__validate_options( $opt, $valid );
    $opt->{default} = $self->{default} if ! defined $opt->{default};
    $opt->{no_echo} = $self->{no_echo} if ! defined $opt->{no_echo};
    $self->{sep} = '';
    my $list = [ [ $prompt, $self->{default} ] ];
    $self->{curr_row} = 0;
    $self->{length_key}[0]   = Unicode::GCString->new( $prompt )->columns;
    $self->{len_longest_key} = $self->{length_key}[0];
    $self->{length_prompt}   = $self->{len_longest_key} + length $self->{sep};
    my $str = Unicode::GCString->new( $opt->{default} );
    my $pos = $str->length();
    local $| = 1;
    $self->__init_term();

    while ( 1 ) {
        if ( $self->{beep} ) {
            $self->{plugin}->__beep();
            $self->{beep} = 0;
        }
        my ( $term_width ) = $self->{plugin}->__term_buff_size();
        $self->{avail_width} = $term_width - 1;
        $self->{avail_width_value} = $self->{avail_width} - $self->{length_prompt};
        $self->__print_readline( $opt, $list, $str, $pos );
        my $key = $self->{plugin}->__get_key();
        if ( ! defined $key ) {
            $self->__reset_term();
            carp "EOT: $!";
            return;
        }
        next if $key == NEXT_get_key;
        next if $key == KEY_TAB;
        if ( $key == KEY_BSPACE || $key == CONTROL_H ) {
            if ( $pos ) {
                $pos--;
                $str->substr( $pos, 1, '' );
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == CONTROL_U ) {
            if ( $pos ) {
                $str->substr( 0, $pos, '' );
                $pos = 0;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == CONTROL_K ) {
            if ( $pos < $str->length() ) {
                $str->substr( $pos, $str->length() - $pos, '' );
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_DELETE || $key == CONTROL_D ) {
            if ( $str->length() ) {
                if ( $pos < $str->length() ) {
                    $str->substr( $pos, 1, '' );
                }
                else {
                    $self->{beep} = 1;
                }
            }
            else {
                print "\n";
                $self->__reset_term();
                return;
            }
        }
        elsif ( $key == VK_RIGHT || $key == CONTROL_F ) {
            if ( $pos < $str->length() ) {
                $pos++;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_LEFT  || $key == CONTROL_B ) {
            if ( $pos ) {
                $pos--;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_END   || $key == CONTROL_E ) {
            if ( $pos < $str->length() ) {
                $pos = $str->length();
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_HOME  || $key == CONTROL_A ) {
            if ( $pos > 0 ) {
                $pos = 0;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_UP || $key == VK_DOWN ) {
            $self->{beep} = 1;
        }
        else {
            $key = chr $key;
            utf8::upgrade $key;
            if ( $key eq "\n" || $key eq "\r" ) { #
                print "\n";
                $self->__reset_term();
                if ( $self->{compat} || ! defined $self->{compat} && $ENV{READLINE_SIMPLE_COMPAT} ) {
                    return encode( 'console_in', $str->as_string );
                }
                return $str->as_string;
            }
            else {
                $str->substr( $pos, 0, $key );
                $pos++;
            }
        }
    }
}


sub __print_readline {
    my ( $self, $opt, $list, $str, $pos ) = @_;
    my $print_str = $str->copy;
    my $print_pos = $pos;
    my $n = 1;
    my ( $b, $e );
    while ( $print_str->columns > $self->{avail_width_value} ) {
        if ( $print_str->substr( 0, $print_pos )->columns > $self->{avail_width_value} / 4 ) {
            $print_str->substr( 0, $n, '' );
            $print_pos -= $n;
            $b = 1;
        }
        else {
            $print_str->substr( -$n, $n, '' );
            $e = 1;
        }
    }
    if ( $b ) {
        $print_str->substr( 0, 1, '<' );
    }
    if ( $e ) {
        $print_str->substr( $print_str->length(), 1, '>' );
    }
    my $key = $self->__padded_or_trimed_key( $list, $self->{curr_row} );
    $self->{plugin}->__clear_line();
    if ( $opt->{mark_curr} ) {
        $self->{plugin}->__mark_current();
        print "\r", $key;
        $self->{plugin}->__reset();
    }
    else {
        print "\r", $key;
    }
    my $sep = $self->{sep};
    if ( any { $_ == $self->{curr_row} - @{$self->{pre_list}} } @{$opt->{ro}} ) {
        $sep = $self->{sep_ro};
    }
    if ( $opt->{no_echo} ) {
        if ( $opt->{no_echo} == 2 ) {
            print $sep;
            return;
        }
        print $sep, '*' x $print_str->length(), "\r";
    }
    else {
        print $sep, $print_str->as_string, "\r";
    }
    $self->{plugin}->__right( $self->{length_prompt} + $print_str->substr( 0, $print_pos )->columns );

}


sub __length_longest_key {
    my ( $self, $list ) = @_;
    my $len = []; #
    my $longest = 0;
    for my $i ( 0 .. $#$list ) {
        my $gcs = Unicode::GCString->new( $list->[$i][0] );
        $len->[$i] = $gcs->columns;
        if ( $i < @{$self->{pre_list}} ) {
            next;
        }
        $longest = $len->[$i] if $len->[$i] > $longest;
    }
    $self->{len_longest_key} = $longest;
    $self->{length_key} = $len;
}


sub __prepare_size {
    my ( $self, $opt, $list, $maxcols, $maxrows ) = @_;
    $self->{avail_width} = $maxcols - 1;
    $self->{avail_height} = $maxrows;
    if ( defined $opt->{main_prompt} ) {
        $self->__nr_prompt_lines( $opt );
        my $backup_height = $self->{avail_height};
        $self->{avail_height} -= $self->{nr_prompt_lines};
        my $min_avail_height = 5;
        if ( $self->{avail_height} < $min_avail_height ) {
            if ( $backup_height > $min_avail_height ) {
                $self->{avail_height} = $min_avail_height;
            }
            else {
                $self->{avail_height} = $backup_height;
            }
        }
    }
    if ( @$list > $self->{avail_height} ) {
        $self->{pages} = int @$list / ( $self->{avail_height} - 1 );
        if ( @$list % ( $self->{avail_height} - 1 ) ) {
            $self->{pages}++;
        }
        $self->{avail_height}--;
    }
    else {
        $self->{pages} = 1;
    }
    return;
}


sub __nr_prompt_lines {
    my ( $self, $opt ) = @_;
    my $prompt = $opt->{main_prompt};
    if ( $prompt eq '' ) {
        $self->{nr_prompt_lines} = 0;
        return;
    }
    #$self->{main_prompt} =~ s/[^\n\P{Space}]/ /g;
    #$self->{main_prompt} =~ s/[^\n\P{C}]//g;
    if ( $prompt !~ /\n/ &&  Unicode::GCString->new( $prompt )->columns <= $self->{avail_width} ) {
        $self->{nr_prompt_lines} = 1;
    }
    else {
        my $line_fold = Text::LineFold->new(
            Charset=> 'utf-8',
            ColMax => $self->{avail_width},
            OutputCharset => '_UNICODE_',
            Urgent => 'FORCE'
        );
        #if ( defined $self->{lf} ) {
        #    $self->{prompt_copy} = $line_fold->fold( ' ' x $self->{lf}[0], ' ' x $self->{lf}[1], $self->{main_prompt} );
        #}
        #else {
            $opt->{main_prompt} = $line_fold->fold( $prompt, 'PLAIN' );
        #}
        $opt->{main_prompt} =~ s/\n\z//;
        $self->{nr_prompt_lines} = $opt->{main_prompt} =~ s/\n/\n\r/g; # #
        $self->{nr_prompt_lines} += 1;
    }
}


sub __gcstring_and_pos {
    my ( $self, $list ) = @_;
    my $default = $list->[$self->{curr_row}][1];
    if ( ! defined $default ) {
        $default = '';
    }
    my $str = Unicode::GCString->new( $default );
    return $str, $str->length();
}


sub __print_current_row {
    my ( $self, $opt, $list, $str, $pos ) = @_;
    $self->{plugin}->__clear_line();
    if ( $self->{curr_row} < @{$self->{pre_list}} ) {
        $self->{plugin}->__reverse();
        print $list->[$self->{curr_row}][0];
        $self->{plugin}->__reset();
    }
    else {
        $self->__print_readline( $opt, $list, $str, $pos );
        $list->[$self->{curr_row}][1] = $str->as_string;
    }
}


sub __print_row {
    my ( $self, $opt, $list, $idx ) = @_;
    if ( $idx < @{$self->{pre_list}} ) {
        return $list->[$idx][0];
    }
    else {
        my $val = defined $list->[$idx][1] ? $list->[$idx][1] : '';
        $val =~ s/\p{Space}/ /g;
        $val =~ s/\p{C}//g;
        my $sep = $self->{sep};
        if ( any { $_ == $idx - @{$self->{pre_list}} } @{$opt->{ro}} ) {
            $sep = $self->{sep_ro};
        }
        return
            $self->__padded_or_trimed_key( $list, $idx ) . $sep .
            $self->__unicode_trim( Unicode::GCString->new( $val ), $self->{avail_width_value} );
    }
}


sub __write_screen {
    my ( $self, $opt, $list ) = @_;
    print join "\n", map { $self->__print_row( $opt, $list, $_ ) } $self->{begin_row} .. $self->{end_row};
    if ( $self->{pages} > 1 ) {
        if ( $self->{avail_height} - ( $self->{end_row} + 1 - $self->{begin_row} ) ) {
            print "\n" x ( $self->{avail_height} - ( $self->{end_row} - $self->{begin_row} ) - 1 );
        }
        $self->{page} = int( $self->{end_row} / $self->{avail_height} ) + 1;
        my $page_number = sprintf '- Page %d/%d -', $self->{page}, $self->{pages};
        if ( length $page_number > $self->{avail_width} ) {
            $page_number = substr sprintf( '%d/%d', $self->{page}, $self->{pages} ), 0, $self->{avail_width};
        }
        print "\n", $page_number;
        $self->{plugin}->__up( $self->{avail_height} - ( $self->{curr_row} - $self->{begin_row} ) );
    }
    else {
        $self->{page} = 1;
        my $up_curr = $self->{end_row} - $self->{curr_row};
        $self->{plugin}->__up( $up_curr );
    }
}


sub __write_first_screen {
    my ( $self, $opt, $list, $curr_row ) = @_;
    if ( $self->{len_longest_key} > $self->{avail_width} / 3 ) {
        $self->{len_longest_key} = int( $self->{avail_width} / 3 );
    }
    my $len_separator = Unicode::GCString->new( $self->{sep} )->columns;
    if ( @{$opt->{ro}} ) {
        my $tmp = Unicode::GCString->new( $self->{sep_ro} )->columns;
        $len_separator = $tmp if $tmp > $len_separator;
    }
    $self->{length_prompt} = $self->{len_longest_key} + $len_separator;
    $self->{avail_width_value} = $self->{avail_width} - $self->{length_prompt};
    $self->{curr_row} = $opt->{auto_up} == 2 ? $curr_row : @{$self->{pre_list}};
    $self->{begin_row} = 0;
    $self->{end_row}  = ( $self->{avail_height} - 1 );
    if ( $self->{end_row} > $#$list ) {
        $self->{end_row} = $#$list;
    }
    if ( defined $opt->{main_prompt} ) {
        print $opt->{main_prompt}, "\n";
    }
    $self->__write_screen( $opt, $list );
}


sub fill_form {
    my ( $self, $orig_list, $opt ) = @_;
    if ( ! defined $orig_list ) {
        croak "'fill_form' called with no argument.";
    }
    elsif ( ref $orig_list ne 'ARRAY' ) {
        croak "'fill_form' requires an ARRAY reference as its argument.";
    }
    if ( defined $opt && ref $opt ne 'HASH' ) {
        croak "'fill_form': the (optional) second argument must be a HASH reference";
    }
    my $valid = {
        prompt    => '',
        back      => '',
        confirm   => '',
        auto_up   => '[ 0 1 2 ]',
        mark_curr => '[ 0 1 ]',
        ro        => 'ARRAY',
####
        sep             => '', # remove
####
    };
    my $list = [ map { [ @$_ ] } @$orig_list ];
    $self->__validate_options( $opt, $valid );
    $opt->{prompt}  = $self->{prompt}  if ! defined $opt->{prompt};
    $opt->{back}    = $self->{back}    if ! defined $opt->{back};
    $opt->{confirm} = $self->{confirm} if ! defined $opt->{confirm};
    $opt->{auto_up} = $self->{auto_up} if ! defined $opt->{auto_up};
    $opt->{ro}      = $self->{ro}      if ! defined $opt->{ro};
    $opt->{main_prompt} = $opt->{prompt};
    $self->{sep}    = ': ';
    $self->{sep_ro} = '| ';
    $self->{pre_list} = [ [ $opt->{confirm} ] ];
    if ( length $opt->{back} ) {
        unshift @{$self->{pre_list}}, [ $opt->{back} ];
    }
    unshift @$list, @{$self->{pre_list}};
    $self->__length_longest_key( $list );
    $self->__init_term();
    local $| = 1;
    my ( $maxcols, $maxrows ) = $self->{plugin}->__term_buff_size();
    $self->__prepare_size( $opt, $list, $maxcols, $maxrows );
    $self->__write_first_screen( $opt, $list, 0 );
    my ( $str, $pos ) = $self->__gcstring_and_pos( $list );

    LINE: while ( 1 ) {
        my $locked = 0;
        if ( any { $_ == $self->{curr_row} - @{$self->{pre_list}} } @{$opt->{ro}} ) {
            $locked = 1;
        }
        if ( $self->{beep} ) {
            $self->{plugin}->__beep();
            $self->{beep} = 0;
        }
        else {
            $self->__print_current_row( $opt, $list, $str, $pos );
        }
        my $key = $self->{plugin}->__get_key();
        if ( ! defined $key ) {
            $self->__reset_term();
            carp "EOT: $!";
            return;
        }
        next if $key == NEXT_get_key;
        next if $key == KEY_TAB;
        my ( $tmp_maxcols, $tmp_maxrows ) = $self->{plugin}->__term_buff_size();
        if ( $tmp_maxcols != $maxcols || $tmp_maxrows != $maxrows && $tmp_maxrows < ( @$list + 1 ) ) {
            ( $maxcols, $maxrows ) = ( $tmp_maxcols, $tmp_maxrows );
            $self->__prepare_size( $opt, $list, $maxcols, $maxrows );
            $self->{plugin}->__clear_screen();
            $self->__write_first_screen( $opt, $list, 1 );
            ( $str, $pos ) = $self->__gcstring_and_pos( $list );
        }
        if ( $key == KEY_BSPACE || $key == CONTROL_H ) {
            if ( $locked ) {
                $self->{beep} = 1;
            }
            elsif ( $pos ) {
                $pos--;
                $str->substr( $pos, 1, '' );
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == CONTROL_U ) {
            if ( $locked ) {
                $self->{beep} = 1;
            }
            elsif ( $pos ) {
                $str->substr( 0, $pos, '' );
                $pos = 0;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == CONTROL_K ) {
            if ( $locked ) {
                $self->{beep} = 1;
            }
            elsif ( $pos < $str->length() ) {
                $str->substr( $pos, $str->length() - $pos, '' );
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_DELETE || $key == CONTROL_D ) {
            if ( $str->length() ) {
                if ( $locked ) {
                    $self->{beep} = 1;
                }
                elsif ( $pos < $str->length() ) {
                    $str->substr( $pos, 1, '' );
                }
                else {
                    $self->{beep} = 1;
                }
            }
            else {
                print "\n";
                $self->__reset_term();
                return;
            }
        }
        elsif ( $key == VK_RIGHT ) {
            if ( $pos < $str->length() ) {
                $pos++;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_LEFT ) {
            if ( $pos ) {
                $pos--;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_END   || $key == CONTROL_E ) {
            if ( $pos < $str->length() ) {
                $pos = $str->length();
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_HOME  || $key == CONTROL_A ) {
            if ( $pos > 0 ) {
                $pos = 0;
            }
            else {
                $self->{beep} = 1;
            }
        }
        elsif ( $key == VK_UP ) {
            if ( $self->{curr_row} == 0 ) {
                $self->{beep} = 1;
            }
            else {
                $self->{curr_row}--;
                ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                if ( $self->{curr_row} >= $self->{begin_row} ) {
                    $self->__reset_previous_row( $opt, $list, $self->{curr_row} + 1 );
                    $self->{plugin}->__up( 1 );
                }
                else {
                    $self->__print_previous_page( $opt, $list );
                }
            }
        }
        elsif ( $key == VK_DOWN ) {
            if ( $self->{curr_row} == $#$list ) {
                $self->{beep} = 1;
            }
            else {
                $self->{curr_row}++;
                ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                if ( $self->{curr_row} <= $self->{end_row} ) {
                    $self->__reset_previous_row( $opt, $list, $self->{curr_row} - 1 );
                    $self->{plugin}->__down( 1 );
                }
                else {
                    $self->{plugin}->__up( $self->{end_row} - $self->{begin_row} );
                    $self->__print_next_page( $opt, $list );
                }
            }
        }
        elsif (  $key == VK_PAGE_UP || $key == CONTROL_B ) {
            if ( $self->{page} == 1 ) {
                if ( $self->{curr_row} == 0 ) {
                    $self->{beep} = 1;
                }
                else {
                    $self->__reset_previous_row( $opt, $list, $self->{curr_row} );
                    $self->{plugin}->__up( $self->{curr_row} );
                    $self->{curr_row} = 0;
                    ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                }
            }
            else {
                $self->{plugin}->__up( $self->{curr_row} - $self->{begin_row} );
                $self->{curr_row} = $self->{begin_row} - $self->{avail_height};
                ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                $self->__print_previous_page( $opt, $list );
            }
        }
        elsif (  $key == VK_PAGE_DOWN || $key == CONTROL_F ) {
            if ( $self->{page} == $self->{pages} ) {
                if ( $self->{curr_row} == $#$list ) {
                    $self->{beep} = 1;
                }
                else {
                    $self->__reset_previous_row( $opt, $list, $self->{curr_row} );
                    $self->{plugin}->__down( $self->{end_row} - $self->{curr_row} );
                    $self->{curr_row} = $self->{end_row};
                    ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                }
            }
            else {
                $self->{plugin}->__up( $self->{curr_row} - $self->{begin_row} );
                $self->{curr_row} = $self->{end_row} + 1;
                ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                $self->__print_next_page( $opt, $list );
            }
        }
        else {
            $key = chr $key;
            utf8::upgrade $key;
            if ( $key eq "\n" || $key eq "\r" ) { #
                my $up = $self->{curr_row} - $self->{begin_row};
                $up += $self->{nr_prompt_lines} if $self->{nr_prompt_lines};
                if ( $list->[$self->{curr_row}][0] eq $opt->{back} ) {
                    $self->{plugin}->__up( $up );
                    $self->{plugin}->__clear_lines_to_end_of_screen();
                    $self->__reset_term();
                    return;
                }
                elsif ( $list->[$self->{curr_row}][0] eq $opt->{confirm} ) {
                    $self->{plugin}->__up( $up );
                    $self->{plugin}->__clear_lines_to_end_of_screen();
                    $self->__reset_term();
                    splice @$list, 0, @{$self->{pre_list}};
                    if ( $self->{compat} || ! defined $self->{compat} && $ENV{READLINE_SIMPLE_COMPAT} ) {
                        return [ map { [ $_->[0], encode( 'console_in', $_->[1] ) ] } @$list ];
                    }
                    return $list;
                }
                if ( $opt->{auto_up} == 2 ) {
                    if ( $self->{curr_row} == 0 ) {
                        $self->{beep} = 1;
                    }
                    else {
                        $self->{plugin}->__up( $up );
                        $self->{plugin}->__clear_lines_to_end_of_screen();
                        ( $str, $pos ) = $self->__write_first_screen( $opt, $list, 0 );
                        ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                    }
                }
                elsif ( $self->{curr_row} == $#$list ) {
                    $self->{plugin}->__up( $up );
                    $self->{plugin}->__clear_lines_to_end_of_screen();
                    ( $str, $pos ) = $self->__write_first_screen( $opt, $list, scalar @{$self->{pre_list}} );
                    ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                    $self->{enter_col} = $pos;
                    $self->{enter_row} = $self->{curr_row};
                }
                else {
                    if ( $opt->{auto_up} == 1 ) {
                        if (    defined $self->{enter_row} && $self->{enter_row} == $self->{curr_row}
                             && defined $self->{enter_col} && $self->{enter_col} == $pos
                        ) {
                            $self->{beep} = 1;
                            next;
                        }
                        else {
                            delete $self->{enter_row};
                            delete $self->{enter_col};
                        }
                    }
                    $self->{curr_row}++;
                    ( $str, $pos ) = $self->__gcstring_and_pos( $list );
                    if ( $self->{curr_row} <= $self->{end_row} ) {
                        $self->__reset_previous_row( $opt, $list, $self->{curr_row} - 1 );
                        $self->{plugin}->__down( 1 );
                    }
                    else {
                        $self->{plugin}->__up( $up );
                        $self->__print_next_page( $opt, $list );
                    }
                }
            }
            else {
                if ( $locked ) {
                    $self->{beep} = 1;
                }
                else {
                    $str->substr( $pos, 0, $key );
                    $pos++;
                }
            }
        }
    }
}


sub __reset_previous_row {
    my ( $self, $opt, $list, $idx ) = @_;
    $self->{plugin}->__clear_line();
    print $self->__print_row( $opt, $list, $idx );
}


sub __print_next_page {
    my ( $self, $opt, $list ) = @_;
    $self->{begin_row} = $self->{end_row} + 1;
    $self->{end_row}   = $self->{end_row} + $self->{avail_height};
    $self->{end_row}   = $#$list if $self->{end_row} > $#$list;
    $self->{plugin}->__clear_lines_to_end_of_screen();
    $self->__write_screen( $opt, $list );
}


sub __print_previous_page {
    my ( $self, $opt, $list ) = @_;
    $self->{end_row}   = $self->{begin_row} - 1;
    $self->{begin_row} = $self->{begin_row} - $self->{avail_height};
    $self->{begin_row} = 0 if $self->{begin_row} < 0;
    $self->{plugin}->__clear_lines_to_end_of_screen();
    $self->__write_screen( $opt, $list );
}


sub __padded_or_trimed_key {
    my ( $self, $list, $idx ) = @_;
    my $unicode;
    my $key_length = $self->{length_key}[$idx];
    my $key = $list->[$idx][0];
    $key =~ s/\p{Space}/ /g;
    $key =~ s/\p{C}//g;
    if ( $key_length > $self->{len_longest_key} ) {
        my $gcs = Unicode::GCString->new( $key );
        $unicode = $self->__unicode_trim( $gcs, $self->{len_longest_key} );
    }
    elsif ( $key_length < $self->{len_longest_key} ) {
        $unicode = " " x ( $self->{len_longest_key} - $key_length ) . $key;
    }
    else {
        $unicode = $key;
    }
    return $unicode;
}


sub __unicode_trim {
    my ( $self, $gcs, $len ) = @_;
    if ( $gcs->columns <= $len ) {
        return $gcs->as_string;
    }
    my $pos = $gcs->pos;
    $gcs->pos( 0 );
    my $cols = 0;
    my $gc;
    while ( defined( $gc = $gcs->next ) ) {
        if ( ( $len - 3 ) < ( $cols += $gc->columns ) ) {
            my $ret = $gcs->substr( 0, $gcs->pos - 1 );
            $gcs->pos( $pos );
            return $ret->as_string . '...';
        }
    }
}


# use utf8;
# use open qw( :std :utf8 );

# use Term::ReadLine::Simple;
# use Term::ReadLine; # 1.14
# use Devel::Peek;

# my $default = 'ü';                    # "\x{fc}"
# character read with readline: 'ä'     # "\x{e4}"


#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Stub' );   # default not supported

#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Perl' );
# my $line = $tr->readline( ': ' );

###  ä    "\303\244"\0

#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Perl' );
# my $line = $tr->readline( ': ', $default );

###  üä   "\303\274\303\203\302\244"\0 [UTF8 "\x{fc}\x{c3}\x{a4}"]

#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Perl', *STDIN, *STDOUT );
# my $line = $tr->readline( ': ', $default );

###  üä    "\303\274\303\244"\0 [UTF8 "\x{fc}\x{e4}"]

#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Gnu 1.26' );
# my $line = $tr->readline( ': ', $default );

###  üä  "\303\274\303\244"\0

#-----------------------------------------------------------

# my $tr = Term::ReadLine->new( 'Gnu 1.26', *STDIN, *STDOUT );
# my $line = $tr->readline( ': ', $default );

###  üä  "\303\274\303\244"\0

#-----------------------------------------------------------

# my $tr = Term::ReadLine::Simple->new();
# $tr->config( { compat => 0 } );
# my $line = $tr->readline( ': ', $default );

###  üä    "\303\274\303\244"\0 [UTF8 "\x{fc}\x{e4}"]

#-----------------------------------------------------------

# my $tr = Term::ReadLine::Simple->new();
# $tr->config( { compat => 1 } );
# my $line = $tr->readline( ': ', $default );

###  üä  "\303\274\303\244"\0


1;

__END__