3 use warnings FATAL
=> 'all';
6 # Highlight by reversing foreground and background. You could do
7 # other things like bold or underline if you prefer.
8 my $HIGHLIGHT = "\x1b[7m";
9 my $UNHIGHLIGHT = "\x1b[27m";
10 my $COLOR = qr/\x1b\[[0-9;]*m/;
11 my $BORING = qr/$COLOR|\s/;
17 # Some scripts may not realize that SIGPIPE is being ignored when launching the
18 # pager--for instance scripts written in Python.
19 $SIG{PIPE
} = 'DEFAULT';
24 $in_hunk = /^$COLOR*\@/;
29 elsif (/^$COLOR*\+/) {
33 show_hunk
(\
@removed, \
@added);
38 $in_hunk = /^$COLOR*[\@ ]/;
41 # Most of the time there is enough output to keep things streaming,
42 # but for something like "git log -Sfoo", you can get one early
43 # commit and then many seconds of nothing. We want to show
44 # that one commit as soon as possible.
46 # Since we can receive arbitrary input, there's no optimal
47 # place to flush. Flushing on a blank line is a heuristic that
48 # happens to match git-log output.
54 # Flush any queued hunk (this can happen when there is no trailing context in
55 # the final diff of the input).
56 show_hunk
(\
@removed, \
@added);
63 # If one side is empty, then there is nothing to compare or highlight.
69 # If we have mismatched numbers of lines on each side, we could try to
70 # be clever and match up similar lines. But for now we are simple and
71 # stupid, and only handle multi-line hunks that remove and add the same
79 for (my $i = 0; $i < @
$a; $i++) {
80 my ($rm, $add) = highlight_pair
($a->[$i], $b->[$i]);
88 my @a = split_line
(shift);
89 my @b = split_line
(shift);
91 # Find common prefix, taking care to skip any ansi
94 my ($pa, $pb) = (0, 0);
95 while ($pa < @a && $pb < @b) {
96 if ($a[$pa] =~ /$COLOR/) {
99 elsif ($b[$pb] =~ /$COLOR/) {
102 elsif ($a[$pa] eq $b[$pb]) {
106 elsif (!$seen_plusminus && $a[$pa] eq '-' && $b[$pb] eq '+') {
116 # Find common suffix, ignoring colors.
117 my ($sa, $sb) = ($#a, $#b);
118 while ($sa >= $pa && $sb >= $pb) {
119 if ($a[$sa] =~ /$COLOR/) {
122 elsif ($b[$sb] =~ /$COLOR/) {
125 elsif ($a[$sa] eq $b[$sb]) {
134 if (is_pair_interesting
(\
@a, $pa, $sa, \
@b, $pb, $sb)) {
135 return highlight_line
(\
@a, $pa, $sa),
136 highlight_line
(\
@b, $pb, $sb);
146 return map { /$COLOR/ ?
$_ : (split //) }
151 my ($line, $prefix, $suffix) = @_;
154 @
{$line}[0..($prefix-1)],
156 @
{$line}[$prefix..$suffix],
158 @
{$line}[($suffix+1)..$#$line]
162 # Pairs are interesting to highlight only if we are going to end up
163 # highlighting a subset (i.e., not the whole line). Otherwise, the highlighting
164 # is just useless noise. We can detect this by finding either a matching prefix
165 # or suffix (disregarding boring bits like whitespace and colorization).
166 sub is_pair_interesting
{
167 my ($a, $pa, $sa, $b, $pb, $sb) = @_;
168 my $prefix_a = join('', @
$a[0..($pa-1)]);
169 my $prefix_b = join('', @
$b[0..($pb-1)]);
170 my $suffix_a = join('', @
$a[($sa+1)..$#$a]);
171 my $suffix_b = join('', @
$b[($sb+1)..$#$b]);
173 return $prefix_a !~ /^$COLOR*-$BORING*$/ ||
174 $prefix_b !~ /^$COLOR*\+$BORING*$/ ||
175 $suffix_a !~ /^$BORING*$/ ||
176 $suffix_b !~ /^$BORING*$/;