From: Ilya Zakharevich Date: Thu, 10 Apr 1997 19:48:07 +0000 (-0400) Subject: Enhancements to debugger, Term::ReadLine, Term::Cap X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6fb2d361298c4eb5d42f1f63b0f74a60d407e546;p=p5sagit%2Fp5-mst-13.2.git Enhancements to debugger, Term::ReadLine, Term::Cap Chip wrote: > I wonder if the public beta can be based on *this* one... Pity I'm late. This patch 1) Fixes Term::Cap which thought that absolute paths start with '/'; 2) Adds a new method `ornaments' to Term::ReadLine; 2a) Documents an old method `tkRunning' of Term::ReadLine; 3) Adds a new `O'ption to debugger: ornaments. Possible values are 0, 1, or comma-separated list of 4 terminal capabilities to surround prompt and the command line. Enjoy, p5p-msgid: 1997Apr10.154825.1929433@hmivax.humgen.upenn.edu private-msgid: 199704101948.PAA01841@monk.mps.ohio-state.edu --- diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm index 0b3b4aa..388f0ed 100644 --- a/lib/Term/Cap.pm +++ b/lib/Term/Cap.pm @@ -105,7 +105,9 @@ sub termcap_path { ## private my @termcap_path; # $TERMCAP, if it's a filespec push(@termcap_path, $ENV{TERMCAP}) if ((exists $ENV{TERMCAP}) && - ($ENV{TERMCAP} =~ /^\//)); + ($ENV{TERMCAP} =~ /^\// + or $^O eq 'os2' and + $ENV{TERMCAP} =~ /^[a-z]:\//i)); if ((exists $ENV{TERMPATH}) && ($ENV{TERMPATH})) { # Add the users $TERMPATH push(@termcap_path, split(/(:|\s+)/, $ENV{TERMPATH})) diff --git a/lib/Term/ReadLine.pm b/lib/Term/ReadLine.pm index 7b735eb..a52b558 100644 --- a/lib/Term/ReadLine.pm +++ b/lib/Term/ReadLine.pm @@ -105,6 +105,15 @@ 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. +The stub package included with the perl distribution allows two +additional methods: C and C. The first one +makes Tk event loop run when waiting for user input (i.e., during +C method), the second one makes the command line stand out +by using termcap data. The argument to C should be 0, 1, +or a string of a form "aa,bb,cc,dd". Four components of this string +should be names of I, first two will be issued to +make the prompt standout, last two to make the input line standout. + =head1 EXPORTS None @@ -121,20 +130,22 @@ If the variable is not set, the best available package is loaded. =cut package Term::ReadLine::Stub; -@ISA = 'Term::ReadLine::Tk'; +@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 $self = shift; my ($in,$out,$str) = @$self; - print $out shift; + 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; @@ -200,7 +211,7 @@ sub OUT { shift->[1] } sub MinLine { undef } sub Attribs { {} } -my %features = (tkRunning => 1); +my %features = (tkRunning => 1, ornaments => 1); sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? @@ -233,6 +244,35 @@ 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; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index f38c3ff..b260a44 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -177,7 +177,7 @@ $inhibit_exit = $option{PrintRet} = 1; compactDump veryCompact quote HighBit undefPrint globPrint PrintRet UsageOnly frame AutoTrace TTY noTTY ReadLine NonStop LineInfo maxTraceLen - recallCommand ShellBang pager tkRunning + recallCommand ShellBang pager tkRunning ornaments signalLevel warnLevel dieLevel inhibit_exit); %optionVars = ( @@ -211,6 +211,7 @@ $inhibit_exit = $option{PrintRet} = 1; warnLevel => \&warnLevel, dieLevel => \&dieLevel, tkRunning => \&tkRunning, + ornaments => \&ornaments, ); %optionRequire = ( @@ -1374,6 +1375,7 @@ sub setterm { if ($term->Features->{setHistory} and "@hist" ne "?") { $term->SetHistory(@hist); } + ornaments($ornaments) if defined $ornaments; } sub readline { @@ -1563,6 +1565,16 @@ sub shellBang { $psh; } +sub ornaments { + if (defined $term) { + local ($warnLevel,$dieLevel) = (0, 1); + return '' unless $term->Features->{ornaments}; + eval { $term->ornaments(@_) } || ''; + } else { + $ornaments = shift; + } +} + sub recallCommand { if (@_) { $rc = quotemeta shift; @@ -1679,6 +1691,7 @@ O [opt[=val]] [opt\"val\"] [opt?]... frame affects printing messages on entry and exit from subroutines. AutoTrace affects printing messages on every possible breaking point. maxTraceLen gives maximal length of evals/args listed in stack trace. + ornaments affects screen appearance of the command line. During startup options are initialized from \$ENV{PERLDB_OPTS}. You can put additional initialization options TTY, noTTY, ReadLine, and NonStop there.