view release on metacpan or  search on metacpan

Gnu.pm  view on Meta::CPAN

sub RL_STATE_DONE {                            # done; accepted line
    $readline_version < 0x0501 ? 0x8_0000 :
    $readline_version < 0x0601 ? 0x80_0000 :
    $readline_version < 0x0700 ? 0x100_0000 : 0x200_0000;
}
sub RL_STATE_TIMEOUT            { 0x400_0000; } # [8.2]
sub RL_STATE_EOF                { 0x800_0000; } # [8.2]
sub RL_STATE_READSTR            { 0x1000_0000; } # [8.3] reading a string for M-x

#
#       Methods Definition
#

=over 4

=item C<ReadLine>

returns the actual package that executes the commands. If
this package is being used, C<Term::ReadLine::Gnu> is returned.

=cut

sub ReadLine { 'Term::ReadLine::Gnu'; }

=item C<new(NAME,[IN,OUT])>

returns the handle for subsequent calls to following functions.
Argument is the name of the application.  Optionally can be followed
by two arguments for C<IN> and C<OUT> file handles. These arguments
should be globs.

=cut

# The origin of this function is Term::ReadLine::Perl.pm by Ilya Zakharevich.
our $has_been_initialized = 0;
sub new {
    my $this = shift;           # Package
    my $class = ref($this) || $this;

    # Debian Bug Report #204362
    croak "Wrong number of arguments" unless @_ == 1 or @_ == 3;
    my $name = shift;

    my $self = \%Attribs;
    bless $self, $class;

    if ($has_been_initialized) {
        croak "Only one Term::ReadLine::Gnu instance is allowed."
    }
    $has_been_initialized = 1;

    # set rl_readline_name before .inputrc is read in rl_initialize()
    $Attribs{readline_name} = $name;

    # on MSWin32 setting $ENV{TERM} does not affect on getenv() in XS
    if ($^O eq 'MSWin32') {
        $Attribs{terminal_name} = $ENV{TERM};
    }

    # some version of Perl cause segmentation fault, if XS module
    # calls setenv() before the 1st assignment to $ENV{}.
    $ENV{_TRL_DUMMY} = '';

    # UTF-8 condition conpatible with Term:ReadLine
    $Attribs{utf8_mode} ||= ${^UNICODE} & 1 || defined ${^ENCODING};
    #printf "\${^UNICODE}: 0x%X, ", ${^UNICODE};
    #print "\${^ENCODING}: ", defined ${^ENCODING} ? 'defined' : 'undef', "\n";

    # set tty before calling rl_initialize() not to output some
    # charactores to STDIO.
    # https://rt.cpan.org/Ticket/Display.html?id=96569
    if (!@_) {
        my ($in, $out) = $self->findConsole();
        open(my $IN,"<$in")   || croak "Cannot open $in for read";
        open(my $OUT,">$out") || croak "Cannot open $out for write";
        if ($Attribs{utf8_mode}) {
            binmode $IN,  ':encoding(UTF-8)'; # not necessary
            binmode $OUT, ':encoding(UTF-8)';
        }
        $self->newTTY($IN, $OUT);
    } else {
        # enable UTF-8 mode if input stream has the utf8 layer.
        my @layers = PerlIO::get_layers($_[0]);
        $Attribs{utf8_mode} ||= ($layers[$#layers] eq 'utf8');

        $self->newTTY(@_);
    }

    # initialize the GNU Readline Library and termcap library
    # This calls tgetent().
    $self->initialize();

    # enable ornaments to be compatible with perl5.004_05(?)
    # This calls tgetstr().
    $self->ornaments(1) unless ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/);

    # keep rl_readline_version value for efficiency
    $readline_version = $Attribs{readline_version};

    # bind operate-and-get-next to \C-o by default for the compatibility
    # with bash and Term::ReadLine::Perl
    # GNU Readline 8.1 and later support operate-and-get-next natively.
    Term::ReadLine::Gnu::XS::rl_add_defun('operate-and-get-next',
                                          \&Term::ReadLine::Gnu::XS::operate_and_get_next, ord "\co")
        if ($readline_version < 0x801);

    $self;
}

sub DESTROY {}

=item C<readline(PROMPT[,PREPUT])>

gets an input line, with actual C<GNU Readline> support.  Trailing
newline is removed.  Returns C<undef> on C<EOF>.  C<PREPUT> is an
optional argument meaning the initial value of input.

The optional argument C<PREPUT> is granted only if the value C<preput>
is in C<Features>.

C<PROMPT> may include some escape sequences.  Use