diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Term/ReadLine.pm | 43 | ||||
| -rw-r--r-- | lib/perl5db.pl | 27 |
2 files changed, 53 insertions, 17 deletions
diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index b6923dd1e7..6b0b5e7f23 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -139,12 +139,23 @@ 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>. +The envrironment 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. +As a special case, if the value of this variable is space-separated, +the tail might be used to disable the ornaments by setting the tail to +be C<o=0> or C<ornaments=0>. The head should be as described above, say + +If the variable is not set, or if the head of space-separated list is +empty, the best available package is loaded. + + export "PERL_RL=Perl o=0" # Use Perl ReadLine without ornaments + export "PERL_RL= o=0" # Use best available ReadLine without ornaments + +(Note that processing of C<PERL_RL> for ornaments is in the discretion of the +particular used C<Term::ReadLine::*> package). =cut @@ -205,7 +216,7 @@ sub new { die "method new called with wrong number of arguments" unless @_==2 or @_==4; #local (*FIN, *FOUT); - my ($FIN, $FOUT); + my ($FIN, $FOUT, $ret); if (@_==2) { ($console, $consoleOUT) = findConsole; @@ -215,15 +226,21 @@ sub new { $sel = select(FOUT); $| = 1; # for DB::OUT select($sel); - bless [\*FIN, \*FOUT]; + $ret = bless [\*FIN, \*FOUT]; } else { # Filehandles supplied $FIN = $_[2]; $FOUT = $_[3]; #OUT->autoflush(1); # Conflicts with debugger? $sel = select($FOUT); $| = 1; # for DB::OUT select($sel); - bless [$FIN, $FOUT]; + $ret = bless [$FIN, $FOUT]; } + if ($ret->Features->{ornaments} + and not ($ENV{PERL_RL} and $ENV{PERL_RL} =~ /\bo\w*=0/)) { + local $Term::ReadLine::termcap_nowarn = 1; + $ret->ornaments(1); + } + return $ret; } sub newTTY { @@ -245,7 +262,7 @@ sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? -my $which = $ENV{PERL_RL}; +my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; if ($which) { if ($which =~ /\bgnu\b/i){ eval "use Term::ReadLine::Gnu;"; @@ -254,7 +271,7 @@ if ($which) { } else { eval "use Term::ReadLine::$which;"; } -} elsif (defined $which) { # Defined but false +} elsif (defined $which and $which ne '') { # Defined but false # Do nothing fancy } else { eval "use Term::ReadLine::Gnu; 1" or eval "use Term::ReadLine::Perl; 1"; @@ -296,7 +313,11 @@ sub ornaments { $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; + unless (defined $terminal) { + warn("Cannot find termcap: $@\n") unless $Term::ReadLine::termcap_nowarn; + $rl_term_set = ',,,'; + return; + } @rl_term_set = map {$_ ? $terminal->Tputs($_,1) || '' : ''} @ts; return $rl_term_set; } diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 9048ed2baf..a4a1b1aae6 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -390,9 +390,9 @@ sub DB { if ($val ne $old_watch[$n]) { $signal = 1; print $OUT <<EOP; -Watchpoint $n: $to_watch[$n] changed: -old value: $old_watch[$n] -new value: $val +Watchpoint $n:\t$to_watch[$n] changed: + old value:\t$old_watch[$n] + new value:\t$val EOP $old_watch[$n] = $val; } @@ -409,6 +409,15 @@ EOP if ($emacs) { $position = "\032\032$filename:$line:0\n"; print $LINEINFO $position; + } elsif ($package eq 'DB::fake') { + print_help(<<EOP); +Debugged program terminated. Use B<q> to quit or B<R> to restart, + use B<O> I<inhibit_exit> to avoid stopping after program termination, + B<h q>, B<h R> or B<h O> to get additional info. +EOP + $package = 'main'; + $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' . + "package $package;"; # this won't let them modify, alas } else { $sub =~ s/\'/::/; $prefix = $sub =~ /::/ ? "" : "${'package'}::"; @@ -1461,8 +1470,14 @@ sub resetterm { # We forked, so we need a different TTY TTY($fork_TTY); undef $fork_TTY; } else { - print $OUT "Forked, but do not know how to change a TTY.\n", - "Define \$DB::fork_TTY or get_fork_TTY().\n"; + print_help(<<EOP); +I<#########> Forked, but do not know how to change a B<TTY>. I<#########> + Define B<\$DB::fork_TTY> + - or a function B<DB::get_fork_TTY()> which will set B<\$DB::fork_TTY>. + The value of B<\$DB::fork_TTY> should be the name of I<TTY> to use. + On I<UNIX>-like systems one can get the name of a I<TTY> for the given window + by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>. +EOP } } @@ -1824,7 +1839,7 @@ B<R> Pure-man-restart of debugger, some of debugger state and the following command-line options: I<-w>, I<-I>, I<-e>. B<h> [I<db_command>] Get help [on a specific debugger command], enter B<|h> to page. B<h h> Summary of debugger commands. -B<q> or B<^D> Quit. Set \$DB::finished to 0 to debug global destruction. +B<q> or B<^D> Quit. Set B<\$DB::finished = 0> to debug global destruction. "; $summary = <<"END_SUM"; |