From: Ilya Zakharevich Date: Wed, 15 Jul 1998 17:02:48 +0000 (-0400) Subject: applied a tweaked version of suggested patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=02ea72ae554bc41558ce4208c02dbcce62b47ecf;p=p5sagit%2Fp5-mst-13.2.git applied a tweaked version of suggested patch Message-Id: <199807152102.RAA19952@monk.mps.ohio-state.edu> Subject: [PATCH 5.004_72] Enable/document colors in re.pm p4raw-id: //depot/perl@1593 --- diff --git a/ext/re/re.pm b/ext/re/re.pm index 4a44753..7cea77d 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -27,6 +27,9 @@ re - Perl pragma to alter regular expression behaviour /^(.*)$/s; # output debugging info during # compile and run time + use re 'debugcolor'; # same as 'debug', but with colored output + ... + (We use $^X in these examples because it's tainted by default.) =head1 DESCRIPTION @@ -57,7 +60,11 @@ When C is in effect, perl emits debugging messages when compiling and using regular expressions. The output is the same as that obtained by running a C<-DDEBUGGING>-enabled perl interpreter with the B<-Dr> switch. It may be quite voluminous depending on the complexity -of the match. +of the match. Using C instead of C enables a +form of output that can be used to get a colorful display on terminals +that understand termcap color sequences. Set C<$ENV{PERL_RE_TC}> to a +comma-separated list of C properties to use for highlighting +strings on/off, pre-point part on/off. See L for additional info. The directive C is I, as the @@ -72,6 +79,23 @@ taint => 0x00100000, eval => 0x00200000, ); +sub setcolor { + eval { # Ignore errors + require Term::Cap; + + my $terminal = Tgetent Term::Cap ({OSPEED => 9600}); # Avoid warning. + my $props = $ENV{PERL_RE_TC} || 'md,me,so,se'; # can use us/ue later + my @props = split /,/, $props; + + + $ENV{TERMCAP_COLORS} = join "\t", map {$terminal->Tputs($_,1)} @props; + }; + + not defined $ENV{TERMCAP_COLORS} or ($ENV{TERMCAP_COLORS} =~ tr/\t/\t/) >= 4 + or not defined $ENV{PERL_RE_TC} + or die "Not enough fields in \$ENV{PERL_RE_TC}=`$ENV{PERL_RE_TC}'"; +} + sub bits { my $on = shift; my $bits = 0; @@ -80,7 +104,8 @@ sub bits { Carp::carp("Useless use of \"re\" pragma"); } foreach my $s (@_){ - if ($s eq 'debug') { + if ($s eq 'debug' or $s eq 'debugcolor') { + setcolor() if $s eq 'debugcolor'; require DynaLoader; @ISA = ('DynaLoader'); bootstrap re;