Skip to content

Commit

Permalink
Newer ReadLine
Browse files Browse the repository at this point in the history 
Finally I could compile GNU ReadLine2.1, so I got some experience with
T::R::Gnu. Unfortunately, debugger could not use any advanced features
of T::R::Gnu since it was accessing the features of T::R::Perl via
backdoors. 

I reworked the interface to use object-oriented methods so that it
should not know anything about the particular ReadLine package it uses
(as far as it conforms to some simple interface). 

Below is that part of the patch which should go into standard
distribution

Consider it as mildly emergent bug fix, it is -w-safe,

Enjoy,

p5p-msgid: 199703040634.BAA19919@monk.mps.ohio-state.edu
  • Loading branch information
Ilya Zakharevich authored and Chip Salzenberg committed Mar 1, 1997
1 parent f3d9a6b commit bcbbe6e
Show file tree
Hide file tree
Showing 2 changed files with 105 additions and 19 deletions.
90 changes: 86 additions & 4 deletions lib/Term/ReadLine.pm
View file
Expand Up @@ -76,6 +76,12 @@ history. Returns the old value.
returns an array with two strings that give most appropriate names for
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>
Returns a reference to a hash with keys being features present in
Expand All @@ -86,26 +92,49 @@ 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.
=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 = 'Term::ReadLine::Tk';

$DB::emacs = $DB::emacs; # To peacify -w

sub ReadLine {'Term::ReadLine::Stub'}
sub readline {
my ($in,$out,$str) = @{shift()};
my $self = shift;
my ($in,$out,$str) = @$self;
print $out shift;
$str = scalar <$in>;
$self->register_Tk
if not $Term::ReadLine::registered and $Term::ReadLine::toloop
and defined &Tk::DoOneEvent;
#$str = scalar <$in>;
$str = $self->get_line;
# bug in 5.000: chomping empty string creats length -1:
chomp $str if defined $str;
$str;
Expand Down Expand Up @@ -166,10 +195,27 @@ sub new {
sub IN { shift->[0] }
sub OUT { shift->[1] }
sub MinLine { undef }
sub Features { {} }
sub Attribs { {} }

my %features = (tkRunning => 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;

Expand All @@ -184,6 +230,42 @@ if (defined &Term::ReadLine::Gnu::readline) {
@ISA = qw(Term::ReadLine::Stub);
}

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;

34 changes: 19 additions & 15 deletions lib/perl5db.pl
View file
Expand Up @@ -157,7 +157,6 @@ package DB;
$dumpvar::quoteHighBit,
$dumpvar::printUndef,
$dumpvar::globPrint,
$readline::Tk_toloop,
$dumpvar::usageOnly,
@ARGS,
$Carp::CarpLevel,
Expand Down Expand Up @@ -189,7 +188,6 @@ package DB;
HighBit => \$dumpvar::quoteHighBit,
undefPrint => \$dumpvar::printUndef,
globPrint => \$dumpvar::globPrint,
tkRunning => \$readline::Tk_toloop,
UsageOnly => \$dumpvar::usageOnly,
frame => \$frame,
AutoTrace => \$trace,
Expand All @@ -212,6 +210,7 @@ package DB;
signalLevel => \&signalLevel,
warnLevel => \&warnLevel,
dieLevel => \&dieLevel,
tkRunning => \&tkRunning,
);

%optionRequire = (
Expand Down Expand Up @@ -1357,15 +1356,13 @@ sub setterm {
} else {
$term = new Term::ReadLine 'perldb', $IN, $OUT;

$readline::rl_basic_word_break_characters .= "[:"
if defined $readline::rl_basic_word_break_characters
and index($readline::rl_basic_word_break_characters, ":") == -1;
$readline::rl_special_prefixes =
$readline::rl_special_prefixes = '$@&%';
$readline::rl_completer_word_break_characters =
$readline::rl_completer_word_break_characters . '$@&%';
$readline::rl_completion_function =
$readline::rl_completion_function = \&db_complete;
$rl_attribs = $term->Attribs;
$rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}'
if defined $rl_attribs->{basic_word_break_characters}
and index($rl_attribs->{basic_word_break_characters}, ":") == -1;
$rl_attribs->{special_prefixes} = '$@&%';
$rl_attribs->{completer_word_break_characters} .= '$@&%';
$rl_attribs->{completion_function} = \&db_complete;
}
$LINEINFO = $OUT unless defined $LINEINFO;
$lineinfo = $console unless defined $lineinfo;
Expand Down Expand Up @@ -1524,6 +1521,15 @@ sub ReadLine {
$rl;
}

sub tkRunning {
if ($ {$term->Features}{tkRunning}) {
return $term->tkRunning(@_);
} else {
print $OUT "tkRunning not supported by current ReadLine package.\n";
0;
}
}

sub NonStop {
if ($term) {
&warn("Too late to set up NonStop mode!\n") if @_;
Expand Down Expand Up @@ -1990,12 +1996,10 @@ sub db_complete {
$out = "=$val ";
}
# Default to value if one completion, to question if many
$readline::rl_completer_terminator_character
= $readline::rl_completer_terminator_character
= (@out == 1 ? $out : '? ');
$rl_attribs->{completer_terminator_character} = (@out == 1 ? $out : '? ');
return sort @out;
}
return &readline::rl_filename_list($text); # filenames
return $term->filename_list($text); # filenames
}

sub end_report { print $OUT "Use `q' to quit and `R' to restart. `h q' for details.\n" }
Expand Down

0 comments on commit bcbbe6e

Please sign in to comment.