From bcbbe6e503cc1899ede8fc1ac0c1c14e432c4f60 Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Tue, 4 Mar 1997 01:34:28 -0500 Subject: [PATCH] Newer ReadLine 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 --- lib/Term/ReadLine.pm | 90 ++++++++++++++++++++++++++++++++++++++++++-- lib/perl5db.pl | 34 +++++++++-------- 2 files changed, 105 insertions(+), 19 deletions(-) diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 88fc6386c38..0c88a76e41d 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -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$in">, C<"Eout">. +=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 stripped. + =item C Returns a reference to a hash with keys being features present in @@ -86,26 +92,49 @@ C method is not dummy. C should be present if lines are put into history automatically (maybe subject to C), and C if C method is not dummy. +If C method reports a feature C as present, the +method C is not dummy. + =back +=head1 Additional supported functions + Actually C 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 stripped. + =head1 EXPORTS None +=head1 ENVIRONMENT + +The variable C 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 or +C. + +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; @@ -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; @@ -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; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 11d0de7bf4c..dbc55314f83 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -157,7 +157,6 @@ package DB; $dumpvar::quoteHighBit, $dumpvar::printUndef, $dumpvar::globPrint, - $readline::Tk_toloop, $dumpvar::usageOnly, @ARGS, $Carp::CarpLevel, @@ -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, @@ -212,6 +210,7 @@ package DB; signalLevel => \&signalLevel, warnLevel => \&warnLevel, dieLevel => \&dieLevel, + tkRunning => \&tkRunning, ); %optionRequire = ( @@ -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; @@ -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 @_; @@ -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" }