1 #!/usr/bin/perl
3 use warnings FATAL => 'all';
4 use strict;
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/;
13 my @window;
15 while (<>) {
16 # We highlight only single-line changes, so we need
17 # a 4-line window to make a decision on whether
18 # to highlight.
19 push @window, $_;
20 next if @window < 4;
21 if ($window[0] =~ /^$COLOR*(\@| )/ &&
22 $window[1] =~ /^$COLOR*-/ &&
23 $window[2] =~ /^$COLOR*\+/ &&
24 $window[3] !~ /^$COLOR*\+/) {
25 print shift @window;
26 show_pair(shift @window, shift @window);
27 }
28 else {
29 print shift @window;
30 }
32 # Most of the time there is enough output to keep things streaming,
33 # but for something like "git log -Sfoo", you can get one early
34 # commit and then many seconds of nothing. We want to show
35 # that one commit as soon as possible.
36 #
37 # Since we can receive arbitrary input, there's no optimal
38 # place to flush. Flushing on a blank line is a heuristic that
39 # happens to match git-log output.
40 if (!length) {
41 local $| = 1;
42 }
43 }
45 # Special case a single-line hunk at the end of file.
46 if (@window == 3 &&
47 $window[0] =~ /^$COLOR*(\@| )/ &&
48 $window[1] =~ /^$COLOR*-/ &&
49 $window[2] =~ /^$COLOR*\+/) {
50 print shift @window;
51 show_pair(shift @window, shift @window);
52 }
54 # And then flush any remaining lines.
55 while (@window) {
56 print shift @window;
57 }
59 exit 0;
61 sub show_pair {
62 my @a = split_line(shift);
63 my @b = split_line(shift);
65 # Find common prefix, taking care to skip any ansi
66 # color codes.
67 my $seen_plusminus;
68 my ($pa, $pb) = (0, 0);
69 while ($pa < @a && $pb < @b) {
70 if ($a[$pa] =~ /$COLOR/) {
71 $pa++;
72 }
73 elsif ($b[$pb] =~ /$COLOR/) {
74 $pb++;
75 }
76 elsif ($a[$pa] eq $b[$pb]) {
77 $pa++;
78 $pb++;
79 }
80 elsif (!$seen_plusminus && $a[$pa] eq '-' && $b[$pb] eq '+') {
81 $seen_plusminus = 1;
82 $pa++;
83 $pb++;
84 }
85 else {
86 last;
87 }
88 }
90 # Find common suffix, ignoring colors.
91 my ($sa, $sb) = ($#a, $#b);
92 while ($sa >= $pa && $sb >= $pb) {
93 if ($a[$sa] =~ /$COLOR/) {
94 $sa--;
95 }
96 elsif ($b[$sb] =~ /$COLOR/) {
97 $sb--;
98 }
99 elsif ($a[$sa] eq $b[$sb]) {
100 $sa--;
101 $sb--;
102 }
103 else {
104 last;
105 }
106 }
108 if (is_pair_interesting(\@a, $pa, $sa, \@b, $pb, $sb)) {
109 print highlight(\@a, $pa, $sa);
110 print highlight(\@b, $pb, $sb);
111 }
112 else {
113 print join('', @a);
114 print join('', @b);
115 }
116 }
118 sub split_line {
119 local $_ = shift;
120 return map { /$COLOR/ ? $_ : (split //) }
121 split /($COLOR*)/;
122 }
124 sub highlight {
125 my ($line, $prefix, $suffix) = @_;
127 return join('',
128 @{$line}[0..($prefix-1)],
129 $HIGHLIGHT,
130 @{$line}[$prefix..$suffix],
131 $UNHIGHLIGHT,
132 @{$line}[($suffix+1)..$#$line]
133 );
134 }
136 # Pairs are interesting to highlight only if we are going to end up
137 # highlighting a subset (i.e., not the whole line). Otherwise, the highlighting
138 # is just useless noise. We can detect this by finding either a matching prefix
139 # or suffix (disregarding boring bits like whitespace and colorization).
140 sub is_pair_interesting {
141 my ($a, $pa, $sa, $b, $pb, $sb) = @_;
142 my $prefix_a = join('', @$a[0..($pa-1)]);
143 my $prefix_b = join('', @$b[0..($pb-1)]);
144 my $suffix_a = join('', @$a[($sa+1)..$#$a]);
145 my $suffix_b = join('', @$b[($sb+1)..$#$b]);
147 return $prefix_a !~ /^$COLOR*-$BORING*$/ ||
148 $prefix_b !~ /^$COLOR*\+$BORING*$/ ||
149 $suffix_a !~ /^$BORING*$/ ||
150 $suffix_b !~ /^$BORING*$/;
151 }