diff options
Diffstat (limited to 'gnu/usr.bin/perl/lib/Term/ReadLine.pm')
| -rw-r--r-- | gnu/usr.bin/perl/lib/Term/ReadLine.pm | 172 |
1 files changed, 163 insertions, 9 deletions
diff --git a/gnu/usr.bin/perl/lib/Term/ReadLine.pm b/gnu/usr.bin/perl/lib/Term/ReadLine.pm index 2ce74231867..b6923dd1e7c 100644 --- a/gnu/usr.bin/perl/lib/Term/ReadLine.pm +++ b/gnu/usr.bin/perl/lib/Term/ReadLine.pm @@ -33,7 +33,7 @@ or as $term->addhistory('row'); -where $term is a return value of Term::ReadLine->Init. +where $term is a return value of Term::ReadLine-E<gt>Init. =over 12 @@ -74,7 +74,13 @@ history. Returns the old value. =item C<findConsole> returns an array with two strings that give most appropriate names for -files for input and output using conventions C<"<$in">, C<"E<gt>out">. +files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">. + +=item Attribs + +returns a reference to a hash which describes internal configuration +of the package. Names of keys in this hash conform to standard +conventions with the leading C<rl_> stripped. =item C<Features> @@ -86,26 +92,79 @@ C<MinLine> method is not dummy. C<autohistory> should be present if lines are put into history automatically (maybe subject to C<MinLine>), and C<addhistory> if C<addhistory> method is not dummy. +If C<Features> method reports a feature C<attribs> as present, the +method C<Attribs> is not dummy. + =back +=head1 Additional supported functions + Actually C<Term::ReadLine> can use some other package, that will support reacher set of commands. +All these commands are callable via method interface and have names +which conform to standard conventions with the leading C<rl_> stripped. + +The stub package included with the perl distribution allows some +additional methods: + +=over 12 + +=item C<tkRunning> + +makes Tk event loop run when waiting for user input (i.e., during +C<readline> method). + +=item C<ornaments> + +makes the command line stand out by using termcap data. The argument +to C<ornaments> should be 0, 1, or a string of a form +C<"aa,bb,cc,dd">. Four components of this string should be names of +I<terminal capacities>, first two will be issued to make the prompt +standout, last two to make the input line standout. + +=item C<newTTY> + +takes two arguments which are input filehandle and output filehandle. +Switches to use these filehandles. + +=back + +One can check whether the currently loaded ReadLine package supports +these methods by checking for corresponding C<Features>. + =head1 EXPORTS None +=head1 ENVIRONMENT + +The variable C<PERL_RL> governs which ReadLine clone is loaded. If the +value is false, a dummy interface is used. If the value is true, it +should be tail of the name of the package to use, such as C<Perl> or +C<Gnu>. + +If the variable is not set, the best available package is loaded. + =cut package Term::ReadLine::Stub; +@ISA = qw'Term::ReadLine::Tk Term::ReadLine::TermCap'; $DB::emacs = $DB::emacs; # To peacify -w +*rl_term_set = \@Term::ReadLine::TermCap::rl_term_set; sub ReadLine {'Term::ReadLine::Stub'} sub readline { - my ($in,$out,$str) = @{shift()}; - print $out shift; - $str = scalar <$in>; + my $self = shift; + my ($in,$out,$str) = @$self; + print $out $rl_term_set[0], shift, $rl_term_set[1], $rl_term_set[2]; + $self->register_Tk + if not $Term::ReadLine::registered and $Term::ReadLine::toloop + and defined &Tk::DoOneEvent; + #$str = scalar <$in>; + $str = $self->get_line; + print $out $rl_term_set[3]; # bug in 5.000: chomping empty string creats length -1: chomp $str if defined $str; $str; @@ -117,13 +176,16 @@ sub findConsole { if (-e "/dev/tty") { $console = "/dev/tty"; - } elsif (-e "con") { + } elsif (-e "con" or $^O eq 'MSWin32') { $console = "con"; } else { $console = "sys\$command"; } - if (defined $ENV{'OS2_SHELL'}) { # In OS/2 + if ($^O eq 'amigaos') { + $console = undef; + } + elsif ($^O eq 'os2') { if ($DB::emacs) { $console = undef; } else { @@ -163,13 +225,40 @@ sub new { bless [$FIN, $FOUT]; } } + +sub newTTY { + my ($self, $in, $out) = @_; + $self->[0] = $in; + $self->[1] = $out; + my $sel = select($out); + $| = 1; # for DB::OUT + select($sel); +} + sub IN { shift->[0] } sub OUT { shift->[1] } sub MinLine { undef } -sub Features { {} } +sub Attribs { {} } + +my %features = (tkRunning => 1, ornaments => 1, 'newTTY' => 1); +sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? -eval "use Term::ReadLine::Gnu;" or eval "use Term::ReadLine::Perl;"; + +my $which = $ENV{PERL_RL}; +if ($which) { + if ($which =~ /\bgnu\b/i){ + eval "use Term::ReadLine::Gnu;"; + } elsif ($which =~ /\bperl\b/i) { + eval "use Term::ReadLine::Perl;"; + } else { + eval "use Term::ReadLine::$which;"; + } +} elsif (defined $which) { # Defined but false + # Do nothing fancy +} else { + eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1"; +} #require FileHandle; @@ -184,6 +273,71 @@ if (defined &Term::ReadLine::Gnu::readline) { @ISA = qw(Term::ReadLine::Stub); } +package Term::ReadLine::TermCap; + +# Prompt-start, prompt-end, command-line-start, command-line-end +# -- zero-width beautifies to emit around prompt and the command line. +@rl_term_set = ("","","",""); +# string encoded: +$rl_term_set = ',,,'; + +sub LoadTermCap { + return if defined $terminal; + + require Term::Cap; + $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. +} + +sub ornaments { + shift; + return $rl_term_set unless @_; + $rl_term_set = shift; + $rl_term_set ||= ',,,'; + $rl_term_set = 'us,ue,md,me' if $rl_term_set == 1; + my @ts = split /,/, $rl_term_set, 4; + eval { LoadTermCap }; + warn("Cannot find termcap: $@\n"), return unless defined $terminal; + @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts; + return $rl_term_set; +} + + +package Term::ReadLine::Tk; + +$count_handle = $count_DoOne = $count_loop = 0; + +sub handle {$giveup = 1; $count_handle++} + +sub Tk_loop { + # Tk->tkwait('variable',\$giveup); # needs Widget + $count_DoOne++, Tk::DoOneEvent(0) until $giveup; + $count_loop++; + $giveup = 0; +} + +sub register_Tk { + my $self = shift; + $Term::ReadLine::registered++ + or Tk->fileevent($self->IN,'readable',\&handle); +} + +sub tkRunning { + $Term::ReadLine::toloop = $_[1] if @_ > 1; + $Term::ReadLine::toloop; +} + +sub get_c { + my $self = shift; + $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; + return getc $self->IN; +} + +sub get_line { + my $self = shift; + $self->Tk_loop if $Term::ReadLine::toloop && defined &Tk::DoOneEvent; + my $in = $self->IN; + return scalar <$in>; +} 1; |