It's Pudge's fault, no it's Aristotle's fault. OK, I guess it's really my own fault. I spent a silly amount of time getting the hilight script to handle nested parens in a fashion which didn't bug me...
I'll be curious to hear if it handles all of Aristotle's favorite test cases too.
-matt
use strict;
use Term::ANSIColor;
use Getopt::Std;
our( @COLOR, $REGULAR_EXPRESSION, $LINE_NUMBER, $NUM_MATCHES, @START, @END, @PROCESSED );
use constant ENTIRE_MATCH => 0;
BEGIN {
getopts( 'c:' ) && @ARGV or die <<" END_USAGE";
usage: $0 [ -c color ] pattern [ file... ] [ < input ]
You can use capturing parens in your pattern.
If you provide multiple atrributes via the -c option,
the first will be used to color the portion matching
the pattern, the second will color the portion matching
the first capturing parens, the third will color the
portion matching the second capturing parens, etc.
Extra colors will be ignored. Extra parens will be
colored the same as the non-captured matching text.
% cat notes.txt
financial notes...
\$25 I owed to "bob smith" on 20041211 explanation: brewfest # some meta data here
\$1 I paid to "sally johnson" on 20041212 explanation: sodas # some meta data here
\$25 I paid to "bob smith" on 20041213 explanation: cash # some meta data here
\$1 I recd from "sally johnson" on 20041215
\$42 I paid to "" on 200412157 explanation: top secret xmass
other notes...
\$100_000_000_000 might be nice to have, eh?
I wonder what I'm doing on tuesday next week.
I like pie.
% $0 \\
-c'cyan, bold, red, green, yellow, magenta, blue, white on_red, bold ' \\
'\\\$\\d+ (I (?:(owed)|(paid)|(recd)) \\S+) "([^"]*)" on (\\d+) *(explanation: (.+))?#?' \\
< notes.txt
END_USAGE
# yes the above looks ugly, but it prints out a tidy usage example
@COLOR = split /,/, our $opt_c || 'bold red';
$REGULAR_EXPRESSION = qr/@{[ shift ]}/;
}
s{ $REGULAR_EXPRESSION }{ paint_match( ENTIRE_MATCH ) }gsex;
sub init_match_info {
return unless $. > ( $LINE_NUMBER || 0 );
$LINE_NUMBER = $.;
@START = @-;
@END = @+;
$NUM_MATCHES = $#END;
@PROCESSED = ();
}
sub paint_match {
init_match_info();
my $match = shift;
return $_ if $match > $NUM_MATCHES;
my( $result, $cursor ) = ( '', $START[ $match ] );
for my $nested_match ( $match + 1 .. $NUM_MATCHES ) {
next if empty( $nested_match ) || $PROCESSED[ $nested_match ];;
last unless match_x_contains_match_y( $match, $nested_match );
$result .= paint_substr( $cursor, $START[ $nested_match ], $match );
$result .= paint_match( $nested_match );
$cursor = $END[ $#PROCESSED ];
}
$result .= paint_substr( $cursor, $END[ $match ], $match );
$PROCESSED[ $match ]++;
return $result;
}
sub paint_substr {
my( $start, $end, $match ) = @_;
return '' unless $end > $start;
return colored( substr( $_, $start, $end - $start ), colors_for_match( $match ) );
}
sub empty{ ! $END[ shift() ] }
sub match_x_contains_match_y {
my( $x, $y ) = @_;
return(
! empty( $x )
and
$END[ $x ] > $START[ $y ]
and
$START[ $x ] <= $END[ $y ]
);
}
sub colors_for_match {
my $match = shift;
return $COLOR[ ENTIRE_MATCH ]
if ( $match == ENTIRE_MATCH or ! $COLOR[ $match ] );
return map {
match_x_contains_match_y( $_, $match) ? $COLOR[ $_ ] : ();
} ENTIRE_MATCH .. $match;
}
maybe@COLOR = split/,/, our $opt_c || 'bold red';
-matt@COLOR = split/,/, our $opt_c || $ENV{HILIGHT_COLORS} || 'bold red';
