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 (file)
--- 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 (file)
--- 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<rl_> stripped.
 
+The stub package included with the perl distribution allows two
+additional methods: C<tkRunning> and C<ornaments>.  The first one
+makes Tk event loop run when waiting for user input (i.e., during
+C<readline> method), the second one 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 "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.
+
 =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 (file)
--- 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.